io.streams/zeta/classes.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Zeta streams classes.
   4 ;;;
   5
   6 (in-package :io.zeta-streams)
   7
   8 ;;;-----------------------------------------------------------------------------
   9 ;;; Types
  10 ;;;-----------------------------------------------------------------------------
  11
  12 (deftype ub8  () '(unsigned-byte 8))
  13 (deftype ub16 () '(unsigned-byte 16))
  14 (deftype ub32 () '(unsigned-byte 32))
  15 (deftype sb8  () '(signed-byte 8))
  16 (deftype sb16 () '(signed-byte 16))
  17 (deftype sb32 () '(signed-byte 32))
  18
  19 (deftype ub8-sarray (&optional (size '*))
  20   `(simple-array ub8 (,size)))
  21
  22 (deftype ub8-vector () '(vector ub8))
  23
  24 (deftype ub16-sarray (&optional (size '*))
  25   `(simple-array ub16 (,size)))
  26
  27 (deftype device-timeout ()
  28   `(or null non-negative-real))
  29 \f
  30
  31 ;;;-----------------------------------------------------------------------------
  32 ;;; Device Classes
  33 ;;;-----------------------------------------------------------------------------
  34
  35 (deftype stream-position () '(unsigned-byte 64))
  36
  37 (defclass device ()
  38   ((input-handle :initarg :input-handle :accessor input-handle-of)
  39    (input-timeout :initarg :input-timeout :accessor input-timeout-of)
  40    (output-handle :initarg :output-handle :accessor output-handle-of)
  41    (output-timeout :initarg :output-timeout :accessor output-timeout-of))
  42   (:default-initargs :input-timeout nil
  43                      :output-timeout nil))
  44
  45 (defclass single-channel-device (device)
  46   ((position :initarg :position :accessor position-of))
  47   (:default-initargs :position 0))
  48
  49 (defclass dual-channel-device (device) ())
  50
  51 (defclass file-device (single-channel-device)
  52   ((filename :initarg :filename :accessor filename-of)
  53    (direction :initarg :direction :accessor direction-of)
  54    (if-exists :initarg :if-exists :accessor if-exists-of)
  55    (if-does-not-exist :initarg :if-does-not-exist :accessor if-does-not-exist-of)))
  56
  57 (defclass direct-device (single-channel-device) ())
  58
  59 (defclass memory-mapped-file-device (file-device direct-device) ())
  60
  61 (defclass memory-buffer-device (direct-device) ())
  62
  63 (defclass socket-device (dual-channel-device)
  64   ((domain :initarg :domain)
  65    (type :initarg :type)
  66    (protocol :initarg :protocol)))
  67 \f
  68
  69 ;;;-----------------------------------------------------------------------------
  70 ;;; Generic functions
  71 ;;;-----------------------------------------------------------------------------
  72
  73 (defgeneric device-open (device &rest initargs))
  74
  75 (defgeneric device-close (device))
  76
  77 (defgeneric device-read (device buffer start end &optional timeout))
  78
  79 (defgeneric device-write (device buffer start end &optional timeout))
  80
  81 (defgeneric device-clear-input (device))
  82
  83 (defgeneric device-clear-output (device))
  84
  85 (defgeneric device-flush-output (device &optional timeout))
  86
  87 (defgeneric device-position (device))
  88
  89 (defgeneric (setf device-position) (position device &rest args))
  90
  91 (defgeneric device-length (device))