From 85f8e0890e5015aa1bc0e9091ec5e80f754aa15c Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Wed, 10 Sep 2008 17:45:30 +0200 Subject: [PATCH] Include trivial-gray-streams. --- LICENCE | 1 + io.streams.asd | 5 +- io.streams/gray/gray-stream-mixin.lisp | 131 +++++++++++++++++++++++++++++++++ io.streams/gray/pkgdcl.lisp | 41 ++++++++++- 4 files changed, 176 insertions(+), 2 deletions(-) create mode 100644 io.streams/gray/gray-stream-mixin.lisp diff --git a/LICENCE b/LICENCE index 3623c9e..4843fa3 100644 --- a/LICENCE +++ b/LICENCE @@ -2,6 +2,7 @@ Copyright (C) 2003, Zach Beane Copyright (C) 2004, Daniel Barlow Copyright (C) 2005-2006, Matthew Backes Copyright (C) 2005-2006, Dan Knapp +Copyright (c) 2005 David Lichteblau Copyright (C) 2006-2008, Stelian Ionescu Copyright (C) 2007, François-René Rideau Copyright (C) 2007, Luís Oliveira diff --git a/io.streams.asd b/io.streams.asd index 53deb06..c07ea26 100644 --- a/io.streams.asd +++ b/io.streams.asd @@ -14,4 +14,7 @@ (:file "classes" :depends-on ("pkgdcl")) (:file "buffer" :depends-on ("pkgdcl" "classes")) (:file "fd-mixin" :depends-on ("pkgdcl" "classes")) - (:file "gray-stream-methods" :depends-on ("pkgdcl" "classes" "buffer" "fd-mixin")))) + (:file "gray-stream-mixin" :depends-on ("pkgdcl")) + (:file "gray-stream-methods" + :depends-on ("pkgdcl" "classes" "buffer" + "fd-mixin" "gray-stream-mixin")))) diff --git a/io.streams/gray/gray-stream-mixin.lisp b/io.streams/gray/gray-stream-mixin.lisp new file mode 100644 index 0000000..7a16f42 --- /dev/null +++ b/io.streams/gray/gray-stream-mixin.lisp @@ -0,0 +1,131 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*- +;;; +;;; --- GRAY stream mixin. +;;; + +(in-package :io.streams) + +(defclass trivial-gray-stream-mixin () ()) + +(defgeneric stream-read-sequence + (stream sequence start end &key &allow-other-keys)) +(defgeneric stream-write-sequence + (stream sequence start end &key &allow-other-keys)) + +(defgeneric stream-file-position (stream)) +(defgeneric (setf stream-file-position) (newval stream)) + +(defmethod stream-write-string + ((stream trivial-gray-stream-mixin) seq &optional start end) + (stream-write-sequence stream seq (or start 0) (or end (length seq)))) + +;; Implementations should provide this default method, I believe, but +;; at least sbcl and allegro don't. +(defmethod stream-terpri ((stream trivial-gray-stream-mixin)) + (write-char #\newline stream)) + +(defmethod stream-file-position ((stream trivial-gray-stream-mixin)) + nil) + +(defmethod (setf stream-file-position) + (newval (stream trivial-gray-stream-mixin)) + (declare (ignore newval)) + nil) + +#+allegro +(progn + (defmethod excl:stream-read-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-read-sequence s seq (or start 0) (or end (length seq)))) + (defmethod stream:stream-write-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-write-sequence s seq (or start 0) (or end (length seq))))) + +#+cmu +(progn + (defmethod ext:stream-read-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-read-sequence s seq (or start 0) (or end (length seq)))) + (defmethod ext:stream-write-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-write-sequence s seq (or start 0) (or end (length seq))))) + +#+lispworks +(progn + (defmethod stream:stream-read-sequence + ((s trivial-gray-stream-mixin) seq start end) + (stream-read-sequence s seq start end)) + (defmethod stream:stream-write-sequence + ((s trivial-gray-stream-mixin) seq start end) + (stream-write-sequence s seq start end)) + + (defmethod stream:stream-file-position ((stream trivial-gray-stream-mixin)) + (stream-file-position stream)) + (defmethod (setf stream:stream-file-position) + (newval (stream trivial-gray-stream-mixin)) + (setf (stream-file-position stream) newval))) + +#+openmcl +(progn + (defmethod ccl:stream-read-vector + ((s trivial-gray-stream-mixin) seq start end) + (stream-read-sequence s seq start end)) + (defmethod ccl:stream-write-vector + ((s trivial-gray-stream-mixin) seq start end) + (stream-write-sequence s seq start end))) + +#+clisp +(progn + (defmethod gray:stream-read-byte-sequence + ((s trivial-gray-stream-mixin) + seq + &optional start end no-hang interactive) + (when no-hang + (error "this stream does not support the NO-HANG argument")) + (when interactive + (error "this stream does not support the INTERACTIVE argument")) + (stream-read-sequence s seq start end)) + + (defmethod gray:stream-write-byte-sequence + ((s trivial-gray-stream-mixin) + seq + &optional start end no-hang interactive) + (when no-hang + (error "this stream does not support the NO-HANG argument")) + (when interactive + (error "this stream does not support the INTERACTIVE argument")) + (stream-write-sequence s seq start end)) + + (defmethod gray:stream-read-char-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-read-sequence s seq start end)) + + (defmethod gray:stream-write-char-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-write-sequence s seq start end)) + + (defmethod gray:stream-position ((stream trivial-gray-stream-mixin) position) + (if position + (setf (stream-file-position stream) position) + (stream-file-position stream)))) + +#+sbcl +(progn + (defmethod sb-gray:stream-read-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-read-sequence s seq (or start 0) (or end (length seq)))) + (defmethod sb-gray:stream-write-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-write-sequence s seq (or start 0) (or end (length seq)))) + ;; SBCL extension: + (defmethod sb-gray:stream-line-length ((stream trivial-gray-stream-mixin)) + 80)) + +#+ecl +(progn + (defmethod gray:stream-read-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-read-sequence s seq (or start 0) (or end (length seq)))) + (defmethod gray:stream-write-sequence + ((s trivial-gray-stream-mixin) seq &optional start end) + (stream-write-sequence s seq (or start 0) (or end (length seq))))) diff --git a/io.streams/gray/pkgdcl.lisp b/io.streams/gray/pkgdcl.lisp index 0116f56..1dd7e81 100644 --- a/io.streams/gray/pkgdcl.lisp +++ b/io.streams/gray/pkgdcl.lisp @@ -6,7 +6,7 @@ (in-package :common-lisp-user) (defpackage :io.streams - (:use :iolib.base :cffi :trivial-gray-streams) + (:use :iolib.base :cffi) (:export ;; Classes #:dual-channel-fd-mixin @@ -42,3 +42,42 @@ #:write-sequence* #:drain-input-buffer )) + +#+cmu +(eval-when (:compile-toplevel :load-toplevel :execute) + (require :gray-streams)) + +#+allegro +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (fboundp 'stream:stream-write-string) + (require "streamc.fasl"))) + +(defvar *gray-stream-symbols* + '(#:fundamental-stream #:fundamental-input-stream + #:fundamental-output-stream #:fundamental-character-stream + #:fundamental-binary-stream #:fundamental-character-input-stream + #:fundamental-character-output-stream + #:fundamental-binary-input-stream + #:fundamental-binary-output-stream #:stream-read-char + #:stream-unread-char #:stream-read-char-no-hang + #:stream-peek-char #:stream-listen #:stream-read-line + #:stream-clear-input #:stream-write-char #:stream-line-column + #:stream-start-line-p #:stream-write-string #:stream-terpri + #:stream-fresh-line #:stream-finish-output #:stream-force-output + #:stream-clear-output #:stream-advance-to-column + #:stream-read-byte #:stream-write-byte)) + +(defparameter *gray-stream-package* + #+allegro :excl + #+cmu :ext + #+clisp :gray + #+ecl :gray + #+(or ccl openmcl) :ccl + #+lispworks :stream + #+sbcl :sb-gray + #-(or allegro cmu clisp ecl ccl openmcl lispworks sbcl) + (error "Your CL implementation isn't supported.")) + +(import (mapcar #'(lambda (s) (find-symbol (string s) *gray-stream-package*)) + *gray-stream-symbols*) + :io.streams) -- 2.11.4.GIT