mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-13 15:10:34 +02:00
Code Activity

Merge commit 'a675a2e81b'

Browse source
This commit is contained in:
Andy Wingo 2014-02-08 14:31:42 +01:00
commit 730639e9a7
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))))