modules/r6rs/i/o/ports.scm

   1 ;;; Guile-R6RS-Libs --- Implementation of R6RS standard libraries.
   2 ;;; Copyright (C) 2007  Ludovic Courtès <ludovic.courtes@laas.fr>
   3 ;;;
   4 ;;; Guile-R6RS-Libs is free software; you can redistribute it and/or
   5 ;;; modify it under the terms of the GNU Lesser General Public
   6 ;;; License as published by the Free Software Foundation; either
   7 ;;; version 2.1 of the License, or (at your option) any later version.
   8 ;;;
   9 ;;; Guile-R6RS-Libs is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;;; Lesser General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU Lesser General Public
  15 ;;; License along with Guile-R6RS-Libs; if not, write to the Free Software
  16 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  17
  18 (define-module (r6rs i/o ports)
  19   :re-export (eof-object? port? input-port? output-port?)
  20   :export (eof-object
  21
  22            ;; input & output ports
  23            port-transcoder binary-port? transcoded-port
  24            port-position set-port-position!
  25            port-has-port-position? port-has-set-port-position!?
  26            call-with-port
  27
  28            ;; input ports
  29            open-bytevector-input-port
  30            make-custom-binary-input-port
  31
  32            ;; binary input
  33            get-u8 lookahead-u8
  34            get-bytevector-n get-bytevector-n!
  35            get-bytevector-some get-bytevector-all
  36
  37            ;; binary output
  38            put-u8 put-bytevector
  39            open-bytevector-output-port))
  40
  41 (load-extension "libguile-r6rs-libs-v-0" "scm_init_r6rs_ports")
  42
  43
  44 \f
  45 ;;;
  46 ;;; Input and output ports.
  47 ;;;
  48
  49 (define (port-transcoder port)
  50   (error "port transcoders are not supported" port))
  51
  52 (define (binary-port? port)
  53   ;; So far, we don't support transcoders other than the binary transcoder.
  54   #t)
  55
  56 (define (transcoded-port port)
  57   (error "port transcoders are not supported" port))
  58
  59 (define (port-position port)
  60   "Return the offset (an integer) indicating where the next octet will be
  61 read from/written to in @var{port}."
  62
  63   ;; FIXME: We should raise an `&assertion' error when not supported.
  64   (seek port 0 SEEK_CUR))
  65
  66 (define (set-port-position! port offset)
  67   "Set the position where the next octet will be read from/written to
  68 @var{port}."
  69
  70   ;; FIXME: We should raise an `&assertion' error when not supported.
  71   (seek port offset SEEK_SET))
  72
  73 (define (port-has-port-position? port)
  74   "Return @code{#t} is @var{port} supports @code{port-position}."
  75   (and (false-if-exception (port-position port)) #t))
  76
  77 (define (port-has-set-port-position!? port)
  78   "Return @code{#t} is @var{port} supports @code{set-port-position!}."
  79   (and (false-if-exception (set-port-position! port (port-position port)))
  80        #t))
  81
  82 (define (call-with-port port proc)
  83   "Call @var{proc}, passing it @var{port} and closing @var{port} upon exit of
  84 @var{proc}.  Return the return values of @var{proc}."
  85   (dynamic-wind
  86       (lambda ()
  87         #t)
  88       (lambda ()
  89         (proc port))
  90       (lambda ()
  91         (close-port port))))
  92
  93
  94 ;;; arch-tag: 6c23e7d7-afd7-48f2-856c-28f7d4f881d8