mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 06:20:23 +02:00
rdelim cleanups
* module/ice-9/rdelim.scm: Clean up export list. (read-line!, read-delimited!, read-delimited, read-line): Use define*.
This commit is contained in:
parent
534bbcc168
commit
3251222637
1 changed files with 94 additions and 116 deletions
|
@ -1,6 +1,6 @@
|
|||
;;; installed-scm-file
|
||||
|
||||
;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -22,122 +22,105 @@
|
|||
;;; similar to (scsh rdelim) but somewhat incompatible.
|
||||
|
||||
(define-module (ice-9 rdelim)
|
||||
:export (read-line read-line! read-delimited read-delimited!
|
||||
%read-delimited! %read-line write-line) ; C
|
||||
)
|
||||
#:export (read-line
|
||||
read-line!
|
||||
read-delimited
|
||||
read-delimited!
|
||||
%read-delimited!
|
||||
%read-line
|
||||
write-line))
|
||||
|
||||
|
||||
(%init-rdelim-builtins)
|
||||
|
||||
(define (read-line! string . maybe-port)
|
||||
(define* (read-line! string #:optional (port current-input-port))
|
||||
;; corresponds to SCM_LINE_INCREMENTORS in libguile.
|
||||
(define scm-line-incrementors "\n")
|
||||
(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))))
|
||||
|
||||
(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 start) terminator)
|
||||
(+ nchars 1))
|
||||
((split) (cons nchars terminator))
|
||||
(else (error "unexpected handle-delim value: "
|
||||
handle-delim))))))))
|
||||
(define* (read-delimited! delims buf #:optional
|
||||
(port (current-input-port)) (handle-delim 'trim)
|
||||
(start 0) (end (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 start) 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 (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))
|
||||
(define* (read-delimited delims #:optional (port (current-input-port))
|
||||
(handle-delim '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 (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)))))))))
|
||||
(else (error "unexpected handle-delim value: "
|
||||
handle-delim))))))))
|
||||
|
||||
;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
|
||||
;;; from PORT. The return value depends on the value of HANDLE-DELIM,
|
||||
|
@ -149,14 +132,9 @@
|
|||
;;; `split', the newline is split from the string and read-line
|
||||
;;; returns a pair consisting of the truncated string and the newline.
|
||||
|
||||
(define (read-line . args)
|
||||
(let* ((port (if (null? args)
|
||||
(current-input-port)
|
||||
(car args)))
|
||||
(handle-delim (if (> (length args) 1)
|
||||
(cadr args)
|
||||
'trim))
|
||||
(line/delim (%read-line port))
|
||||
(define* (read-line #:optional (port (current-input-port))
|
||||
(handle-delim 'trim))
|
||||
(let* ((line/delim (%read-line port))
|
||||
(line (car line/delim))
|
||||
(delim (cdr line/delim)))
|
||||
(case handle-delim
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue