mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

SRFI-4 predicates, length accessors only accept bytevectors (not arrays)

Browse source 
* module/srfi/srfi-4.scm (define-bytevector-type): For the predicates
  and length accessors, only accept bytevectors.  Since arrays don't
  work for u32vector-ref et al, they shouldn't pass u32vector?.
This commit is contained in:
Andy Wingo 2014-02-07 17:53:01 +01:00
parent 9b5da400dd
commit a675a2e81b
1 changed files with 3 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/srfi/srfi-4.scm
View file

@ -1,7 +1,7 @@
;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes ;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes
;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010, ;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010,
;; 2012 Free Software Foundation, Inc. ;; 2012, 2014 Free Software Foundation, Inc.
;; ;;
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -75,14 +75,11 @@
(define-macro (define-bytevector-type tag infix size) (define-macro (define-bytevector-type tag infix size)
`(begin `(begin
(define (,(symbol-append tag 'vector?) obj) (define (,(symbol-append tag 'vector?) obj)
(and (uniform-vector? obj) (and (bytevector? obj) (eq? (array-type obj) ',tag)))
(eq? (uniform-vector-element-type obj) ',tag)))
(define (,(symbol-append 'make- tag 'vector) len . fill) (define (,(symbol-append 'make- tag 'vector) len . fill)
(apply make-srfi-4-vector ',tag len fill)) (apply make-srfi-4-vector ',tag len fill))
(define (,(symbol-append tag 'vector-length) v) (define (,(symbol-append tag 'vector-length) v)
(let ((len (* (uniform-vector-length v) (let ((len (/ (bytevector-length v) ,size)))
(uniform-vector-element-size v)
(/ ,size))))
(if (integer? len) (if (integer? len)
len len
(error "fractional length" v ',tag ,size)))) (error "fractional length" v ',tag ,size))))