module/ice-9/rdelim.scm

   1 ;;; installed-scm-file
   2
   3 ;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013,
   4 ;;;;   2014 Free Software Foundation, Inc.
   5 ;;;;
   6 ;;;; This library is free software; you can redistribute it and/or
   7 ;;;; modify it under the terms of the GNU Lesser General Public
   8 ;;;; License as published by the Free Software Foundation; either
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  11 ;;;; This library is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;;;; Lesser General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU Lesser General Public
  17 ;;;; License along with this library; if not, write to the Free Software
  18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19 ;;;;
  20 \f
  21
  22 ;;; This is the Scheme part of the module for delimited I/O.  It's
  23 ;;; similar to (scsh rdelim) but somewhat incompatible.
  24
  25 (define-module (ice-9 rdelim)
  26   #:export (read-line
  27             read-line!
  28             read-delimited
  29             read-delimited!
  30             read-string
  31             read-string!
  32             %read-delimited!
  33             %read-line
  34             write-line))
  35
  36
  37 (%init-rdelim-builtins)
  38
  39 (define* (read-line! string #:optional (port current-input-port))
  40   ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
  41   (define scm-line-incrementors "\n")
  42   (let* ((rv (%read-delimited! scm-line-incrementors
  43                                string
  44                                #t
  45                                port))
  46          (terminator (car rv))
  47          (nchars (cdr rv)))
  48     (cond ((and (= nchars 0)
  49                 (eof-object? terminator))
  50            terminator)
  51           ((not terminator) #f)
  52           (else nchars))))
  53
  54 (define* (read-delimited! delims buf #:optional
  55                           (port (current-input-port)) (handle-delim 'trim)
  56                           (start 0) (end (string-length buf)))
  57   (let* ((rv (%read-delimited! delims
  58                                buf
  59                                (not (eq? handle-delim 'peek))
  60                                port
  61                                start
  62                                end))
  63          (terminator (car rv))
  64          (nchars (cdr rv)))
  65     (cond ((or (not terminator)         ; buffer filled
  66                (eof-object? terminator))
  67            (if (zero? nchars)
  68                (if (eq? handle-delim 'split)
  69                    (cons terminator terminator)
  70                    terminator)
  71                (if (eq? handle-delim 'split)
  72                    (cons nchars terminator)
  73                    nchars)))
  74           (else
  75            (case handle-delim
  76              ((trim peek) nchars)
  77              ((concat) (string-set! buf (+ nchars start) terminator)
  78               (+ nchars 1))
  79              ((split) (cons nchars terminator))
  80              (else (error "unexpected handle-delim value: "
  81                           handle-delim)))))))
  82
  83 (define* (read-delimited delims #:optional (port (current-input-port))
  84                          (handle-delim 'trim))
  85   (let loop ((substrings '())
  86              (total-chars 0)
  87              (buf-size 100))            ; doubled each time through.
  88     (let* ((buf (make-string buf-size))
  89            (rv (%read-delimited! delims
  90                                  buf
  91                                  (not (eq? handle-delim 'peek))
  92                                  port))
  93            (terminator (car rv))
  94            (nchars (cdr rv))
  95            (new-total (+ total-chars nchars)))
  96       (cond
  97        ((not terminator)
  98         ;; buffer filled.
  99         (loop (cons (substring buf 0 nchars) substrings)
 100               new-total
 101               (* buf-size 2)))
 102        ((and (eof-object? terminator) (zero? new-total))
 103         (if (eq? handle-delim 'split)
 104             (cons terminator terminator)
 105             terminator))
 106        (else
 107         (let ((joined
 108                (string-concatenate-reverse
 109                 (cons (substring buf 0 nchars) substrings))))
 110           (case handle-delim
 111             ((concat)
 112              (if (eof-object? terminator)
 113                  joined
 114                  (string-append joined (string terminator))))
 115             ((trim peek) joined)
 116             ((split) (cons joined terminator))
 117             (else (error "unexpected handle-delim value: "
 118                          handle-delim)))))))))
 119
 120 (define-syntax-rule (check-arg exp message arg ...)
 121   (unless exp
 122     (error message arg ...)))
 123
 124 (define (index? n)
 125   (and (integer? n) (exact? n) (>= n 0)))
 126
 127 (define* (read-string! buf #:optional
 128                        (port (current-input-port))
 129                        (start 0) (end (string-length buf)))
 130   "Read all of the characters out of PORT and write them to BUF.
 131 Returns the number of characters read.
 132
 133 This function only reads out characters from PORT if it will be able to
 134 write them to BUF.  That is to say, if BUF is smaller than the number of
 135 available characters, then BUF will be filled, and characters will be
 136 left in the port."
 137   (check-arg (string? buf) "not a string" buf)
 138   (check-arg (index? start) "bad index" start)
 139   (check-arg (index? end) "bad index" end)
 140   (check-arg (<= start end) "start beyond end" start end)
 141   (check-arg (<= end (string-length buf)) "end beyond string length" end)
 142   (let lp ((n start))
 143     (if (< n end)
 144         (let ((c (read-char port)))
 145           (if (eof-object? c)
 146               (- n start)
 147               (begin
 148                 (string-set! buf n c)
 149                 (lp (1+ n)))))
 150         (- n start))))
 151
 152 (define* read-string
 153   (case-lambda*
 154    "Read all of the characters out of PORT and return them as a string.
 155 If the COUNT argument is present, treat it as a limit to the number of
 156 characters to read.  By default, there is no limit."
 157    ((#:optional (port (current-input-port)))
 158     ;; Fast path.
 159     ;; This creates more garbage than using 'string-set!' as in
 160     ;; 'read-string!', but currently that is faster nonetheless.
 161     (let loop ((chars '()))
 162       (let ((char (read-char port)))
 163         (if (eof-object? char)
 164             (list->string (reverse! chars))
 165             (loop (cons char chars))))))
 166    ((port count)
 167     ;; Slower path.
 168     (let loop ((chars '())
 169                (total 0))
 170       (let ((char (read-char port)))
 171         (if (or (eof-object? char) (>= total count))
 172             (list->string (reverse chars))
 173             (loop (cons char chars) (+ 1 total))))))))
 174
 175
 176 ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
 177 ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
 178 ;;; which may be one of the symbols `trim', `concat', `peek' and
 179 ;;; `split'.  If it is `trim' (the default), the trailing newline is
 180 ;;; removed and the string is returned.  If `concat', the string is
 181 ;;; returned with the trailing newline intact.  If `peek', the newline
 182 ;;; is left in the input port buffer and the string is returned.  If
 183 ;;; `split', the newline is split from the string and read-line
 184 ;;; returns a pair consisting of the truncated string and the newline.
 185
 186 (define* (read-line #:optional (port (current-input-port))
 187                     (handle-delim 'trim))
 188   (let* ((line/delim    (%read-line port))
 189          (line          (car line/delim))
 190          (delim         (cdr line/delim)))
 191     (case handle-delim
 192       ((trim) line)
 193       ((split) line/delim)
 194       ((concat) (if (and (string? line) (char? delim))
 195                     (string-append line (string delim))
 196                     line))
 197       ((peek) (if (char? delim)
 198                   (unread-char delim port))
 199               line)
 200       (else
 201        (error "unexpected handle-delim value: " handle-delim)))))