mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00
Code Activity

rdelim cleanups

Browse source 
* module/ice-9/rdelim.scm: Clean up export list.
  (read-line!, read-delimited!, read-delimited, read-line): Use
  define*.
This commit is contained in:
Andy Wingo 2010-10-19 22:58:00 +02:00
parent 534bbcc168
commit 3251222637
1 changed files with 94 additions and 116 deletions
Download patch file Download diff file Expand all files Collapse all files

210
module/ice-9/rdelim.scm
View file

@ -1,6 +1,6 @@
;;; installed-scm-file ;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -22,122 +22,105 @@
;;; similar to (scsh rdelim) but somewhat incompatible. ;;; similar to (scsh rdelim) but somewhat incompatible.
(define-module (ice-9 rdelim) (define-module (ice-9 rdelim)
:export (read-line read-line! read-delimited read-delimited! #:export (read-line
%read-delimited! %read-line write-line) ; C read-line!
) read-delimited
read-delimited!
%read-delimited!
%read-line
write-line))
(%init-rdelim-builtins) (%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. ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
(define scm-line-incrementors "\n") (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) (define* (read-delimited! delims buf #:optional
(car maybe-port) (port (current-input-port)) (handle-delim 'trim)
(current-input-port)))) (start 0) (end (string-length buf)))
(let* ((rv (%read-delimited! scm-line-incrementors (let* ((rv (%read-delimited! delims
string buf
#t (not (eq? handle-delim 'peek))
port)) port
(terminator (car rv)) start
(nchars (cdr rv))) end))
(cond ((and (= nchars 0) (terminator (car rv))
(eof-object? terminator)) (nchars (cdr rv)))
terminator) (cond ((or (not terminator) ; buffer filled
((not terminator) #f) (eof-object? terminator))
(else nchars))))) (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 . args) (define* (read-delimited delims #:optional (port (current-input-port))
(let* ((num-args (length args)) (handle-delim 'trim))
(port (if (> num-args 0) (let loop ((substrings '())
(car args) (total-chars 0)
(current-input-port))) (buf-size 100)) ; doubled each time through.
(handle-delim (if (> num-args 1) (let* ((buf (make-string buf-size))
(cadr args) (rv (%read-delimited! delims
'trim)) buf
(start (if (> num-args 2) (not (eq? handle-delim 'peek))
(caddr args) port))
0)) (terminator (car rv))
(end (if (> num-args 3) (nchars (cdr rv))
(cadddr args) (join-substrings
(string-length buf)))) (lambda ()
(let* ((rv (%read-delimited! delims (apply string-append
buf (reverse
(not (eq? handle-delim 'peek)) (cons (if (and (eq? handle-delim 'concat)
port (not (eof-object? terminator)))
start (string terminator)
end)) "")
(terminator (car rv)) (cons (substring buf 0 nchars)
(nchars (cdr rv))) substrings))))))
(cond ((or (not terminator) ; buffer filled (new-total (+ total-chars nchars)))
(eof-object? terminator)) (cond ((not terminator)
(if (zero? nchars) ;; buffer filled.
(if (eq? handle-delim 'split) (loop (cons (substring buf 0 nchars) substrings)
(cons terminator terminator) new-total
terminator) (* buf-size 2)))
(if (eq? handle-delim 'split) ((eof-object? terminator)
(cons nchars terminator) (if (zero? new-total)
nchars))) (if (eq? handle-delim 'split)
(else (cons terminator terminator)
(case handle-delim terminator)
((trim peek) nchars) (if (eq? handle-delim 'split)
((concat) (string-set! buf (+ nchars start) terminator) (cons (join-substrings) terminator)
(+ nchars 1)) (join-substrings))))
((split) (cons nchars terminator)) (else
(else (error "unexpected handle-delim value: " (case handle-delim
handle-delim)))))))) ((trim peek concat) (join-substrings))
((split) (cons (join-substrings) terminator))
(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))
(else (error "unexpected handle-delim value: " (else (error "unexpected handle-delim value: "
handle-delim))))))))) handle-delim))))))))
;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
;;; from PORT. The return value depends on the value of HANDLE-DELIM, ;;; 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 ;;; `split', the newline is split from the string and read-line
;;; returns a pair consisting of the truncated string and the newline. ;;; returns a pair consisting of the truncated string and the newline.
(define (read-line . args) (define* (read-line #:optional (port (current-input-port))
(let* ((port (if (null? args) (handle-delim 'trim))
(current-input-port) (let* ((line/delim (%read-line port))
(car args)))
(handle-delim (if (> (length args) 1)
(cadr args)
'trim))
(line/delim (%read-line port))
(line (car line/delim)) (line (car line/delim))
(delim (cdr line/delim))) (delim (cdr line/delim)))
(case handle-delim (case handle-delim