mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 09:20:23 +02:00
Code Activity

* boot-9.scm (read-line!, read-delimited!, read-delimited,

Browse source 
read-line): new	procedures, see libguile/ChangeLog.
This commit is contained in:
Gary Houston 1997-01-25 18:24:54 +00:00
parent 1146b6cda2
commit 1e531c3aee
2 changed files with 121 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ice-9/ChangeLog
View file

@ -1,3 +1,8 @@
Fri Jan 24 06:05:36 1997 Gary Houston <ghouston@actrix.gen.nz>
* boot-9.scm (read-line!, read-delimited!, read-delimited,
read-line): new procedures, see libguile/ChangeLog.
Thu Jan 16 17:07:03 1997 Marius Vollmer <mvo@zagadka.ping.de>
Added dynamic linking of modules. See libguile/DYNAMIC-LINKING.

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

@ -159,6 +159,122 @@
(if pair
(symbol-pset! sym (delq! pair (symbol-pref sym))))))
;;; {Line and Delimited I/O}
;;; corresponds to SCM_LINE_INCREMENTORS in libguile.
(define scm-line-incrementors "\n")
(define (read-line! string . maybe-port)
(let* ((port (if (pair? maybe-port)
(car maybe-port)
(current-input-port))))
(let* ((rv (%read-delimited! scm-line-incrementors
string
#t
port))
(terminator (car rv))
(nchars (cdr rv)))
(cond ((and (= nchars 0)
(eof-object? terminator))
terminator)
((not terminator) #f)
(else nchars)))))
(define (read-delimited! delims buf . args)
(let* ((num-args (length args))
(port (if (> num-args 0)
(car args)
(current-input-port)))
(handle-delim (if (> num-args 1)
(cadr args)
'trim))
(start (if (> num-args 2)
(caddr args)
0))
(end (if (> num-args 3)
(cadddr args)
(string-length buf))))
(let* ((rv (%read-delimited! delims
buf
(not (eq? handle-delim 'peek))
port
start
end))
(terminator (car rv))
(nchars (cdr rv)))
(cond ((or (not terminator) ; buffer filled
(eof-object? terminator))
(if (zero? nchars)
(if (eq? handle-delim 'split)
(cons terminator terminator)
terminator)
(if (eq? handle-delim 'split)
(cons nchars terminator)
nchars)))
(else
(case handle-delim
((trim peek) nchars)
((concat) (string-set! buf nchars terminator)
(+ nchars 1))
((split) (cons nchars terminator))
(else (error "unexpected handle-delim value: "
handle-delim))))))))
(define (read-delimited delims . args)
(let* ((port (if (pair? args)
(let ((pt (car args)))
(set! args (cdr args))
pt)
(current-input-port)))
(handle-delim (if (pair? args)
(car args)
'trim)))
(let loop ((substrings ())
(total-chars 0)
(buf-size 100)) ; doubled each time through.
(let* ((buf (make-string buf-size))
(rv (%read-delimited! delims
buf
(not (eq? handle-delim 'peek))
port))
(terminator (car rv))
(nchars (cdr rv))
(join-substrings
(lambda ()
(apply string-append
(reverse
(cons (if (and (eq? handle-delim 'concat)
(not (eof-object? terminator)))
(string terminator)
"")
(cons (make-shared-substring buf 0 nchars)
substrings))))))
(new-total (+ total-chars nchars)))
(cond ((not terminator)
;; buffer filled.
(loop (cons (substring buf 0 nchars) substrings)
new-total
(* buf-size 2)))
((eof-object? terminator)
(if (zero? new-total)
(if (eq? handle-delim 'split)
(cons terminator terminator)
terminator)
(if (eq? handle-delim 'split)
(cons (join-substrings) terminator)
(join-substrings))))
(else
(case handle-delim
((trim peek concat) (join-substrings))
((split) (cons (join-substrings) terminator))
(else (error "unexpected handle-delim value: "
handle-delim)))))))))
(define (read-line . args)
(apply read-delimited scm-line-incrementors args))
;;; {Arrays}
;;;