Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 151 lines (134 sloc) 5.763 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
#lang scheme
;;; Typed Vector Collection
;;; typed-variable.ss
;;; Copyright (c) 2009 M. Douglas Williams
;;;
;;; This file is part of the Typed Vector Collection.
;;;
;;; The Typed Vector Collection is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the License,
;;; or (at your option) any later version.
;;;
;;; The Typed Vector Collection is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with the Typed Vector Collection. If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; -----------------------------------------------------------------------------
;;; Version Date Comment
;;; 1.0.0 2009/08/17 Initial version. (MDW)
;;;
;;; -----------------------------------------------------------------------------
;;; To Do:
;;;
;;; -----------------------------------------------------------------------------

(require "vtype.ss")

;;; Structure typed-vector
;;; A typed-vector instance is an actual vector of the specified vtype.
(define-values (struct:typed-vector
                typed-vector-constructor
                typed-vector-predicate?
                typed-vector-field-ref
                set-typed-vector-field!)
  (make-struct-type 'typed-vector #f 2 0))

;;; Structure typed-vector, vtype field (read-only)
;;; The vtype instance for this typed-vector instance.
(define typed-vector-vtype
  (make-struct-field-accessor typed-vector-field-ref 0 'vtype))

;;; Structure typed-vector, vtype-specifier pseudo field (read-only)
;;; This is short-cut to the specifier value in the vtype instance.
(define (typed-vector-vtype-specifier typed-vector)
  (vtype-specifier (typed-vector-vtype typed-vector)))

;;; Structure typed-vector, data field (read-only)
;;; The actual data for this typed-vector instance. Its type is determined
;;; by the vtype specified when it's created.
(define typed-vector-data
  (make-struct-field-accessor typed-vector-field-ref 1 'data))

;;; typed-vector?: any? -> boolean?
;;; typed-vector?: (or/c vtype? symbol?) x any? -> boolean?
;;; Returns #t if the object is a typed-vector and, optionally, if it is of
;;; the specified vtype.
(define typed-vector?
  (case-lambda
    ((obj) (typed-vector-predicate? obj))
    ((vtype-or-symbol obj)
     (eq? (typed-vector-vtype obj)
          (vtype-or-symbol->vtype vtype-or-symbol)))))

;;; make-typed-vector: (or/c vtype? symbol?) x natural? -> typed-vector?
;;; make-typed-vector: (or/c vtype? symbol?) x natural? x any? -> typed-vector?
;;; Returns a newly created typed-vector instance of the specified vtype.
(define (make-typed-vector vtype-or-symbol length . opt-fill)
  (let* ((vtype (vtype-or-symbol->vtype vtype-or-symbol))
         (coerce-f (vtype-coerce-f vtype))
         (make-vector-f (vtype-make-vector-f vtype)))
    (typed-vector-constructor
     vtype (apply make-vector-f length
                  (if (null? opt-fill) '() (list (coerce-f (car opt-fill))))))))

;;; typed-vector: (or/c vtype? symbol?) x any? ... -> typed-vector?
(define (typed-vector vtype-or-symbol . list)
  (let* ((vtype (vtype-or-symbol->vtype vtype-or-symbol))
         (coerce-f (vtype-coerce-f vtype))
         (vector-f (vtype-vector-f vtype)))
    (typed-vector-constructor
     vtype (apply vector-f (map coerce-f list)))))

;;; typed-vector-ref: vtype-vector? x integer? -> any
(define (typed-vector-ref typed-vector i)
  ((vtype-vector-ref-f (typed-vector-vtype typed-vector))
   (typed-vector-data typed-vector) i))

;;; typed-vector-set!: typed-vector? x integer? x any?
(define (typed-vector-set! typed-vector i value)
  (let* ((vtype (typed-vector-vtype typed-vector))
         (coerce-f (vtype-coerce-f vtype)))
    ((vtype-vector-set!-f vtype)
     (typed-vector-data typed-vector) i (coerce-f value))))

;;; typed-vector->list: typed-vector> -> list?
(define (typed-vector->list typed-vector)
  ((vtype-vector->list-f (typed-vector-vtype typed-vector))
   (typed-vector-data typed-vector)))

;;; list->typed-vector: (or/c vtype? symbol?) x any? ... -> typed-vector
(define (list->typed-vector vtype-or-symbol list)
  (apply typed-vector vtype-or-symbol list))

;;; typed-vector-base: typed-vector? -> typed-vector?
(define (typed-vector-base typed-vector)
  (let ((base-vtype (vtype-base-vtype (typed-vector-vtype typed-vector))))
    (if base-vtype
        (typed-vector-constructor base-vtype (typed-vector-data typed-vector))
        typed-vector)))

;;; Module Interface

(provide vtype? vtype-or-symbol->vtype vtype-specifier
         object u8 u16 u32 u64 s8 s16 s32 s64 f32 f64
         cu8 cu16 cu32 cu64 cs8 cs16 cs32 cs64 cf32 cf64)

(provide/contract
 (typed-vector-vtype
  (-> typed-vector? vtype?))
 (typed-vector-vtype-specifier
  (-> typed-vector? symbol?))
 (typed-vector-data
  (-> typed-vector? any))
 (typed-vector?
  (case->
   (-> any/c boolean?)
   (-> (or/c vtype? symbol?) boolean?)))
 (make-typed-vector
  (->* ((or/c vtype? symbol?) natural-number/c)
       (any/c)
       typed-vector?))
 (typed-vector
  (->* ((or/c vtype? symbol?))
       () #:rest (listof any/c)
       typed-vector?))
 (typed-vector-ref
  (-> typed-vector? natural-number/c any))
 (typed-vector-set!
  (-> typed-vector? natural-number/c any/c any))
 (typed-vector->list
  (-> typed-vector? list?))
 (list->typed-vector
  (-> (or/c vtype? symbol?) (listof any/c) typed-vector?))
 (typed-vector-base
  (-> typed-vector? typed-vector?)))
Something went wrong with that request. Please try again.