Merge commit '894d0b894daae001495c748b3352cd79918d3789'

[bpt/guile.git] / module / srfi / srfi-4.scm

diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index 43f5ef6..b2e6f49 100644 (file)
--- a/module/srfi/srfi-4.scm
+++ b/module/srfi/srfi-4.scm
@@ -1,7 +1,7 @@
 ;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes
 
 ;; 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
 ;; modify it under the terms of the GNU Lesser General Public
@@ -69,19 +69,17 @@
             f64vector? make-f64vector f64vector f64vector-length f64vector-ref
             f64vector-set! f64vector->list list->f64vector))
 
+(cond-expand-provide (current-module) '(srfi-4))
 
 ;; Need quasisyntax to do this effectively using syntax-case
 (define-macro (define-bytevector-type tag infix size)
   `(begin
      (define (,(symbol-append tag 'vector?) obj)
-       (and (uniform-vector? obj)
-            (eq? (uniform-vector-element-type obj) ',tag)))
+       (and (bytevector? obj) (eq? (array-type obj) ',tag)))
      (define (,(symbol-append 'make- tag 'vector) len . fill)
        (apply make-srfi-4-vector ',tag len fill))
      (define (,(symbol-append tag 'vector-length) v)
-       (let ((len (* (uniform-vector-length v)
-                     (uniform-vector-element-size v)
-                     (/ ,size))))
+       (let ((len (/ (bytevector-length v) ,size)))
          (if (integer? len)
              len
              (error "fractional length" v ',tag ,size))))
@@ -118,21 +116,3 @@
 (define-bytevector-type s64 s64-native 8)
 (define-bytevector-type f32 ieee-single-native 4)
 (define-bytevector-type f64 ieee-double-native 8)
-
-(define (bytevector-c32-ref v i)
-  (make-rectangular (bytevector-ieee-single-native-ref v i)
-                    (bytevector-ieee-single-native-ref v (+ i 4))))
-(define (bytevector-c32-set! v i x)
-  (bytevector-ieee-single-native-set! v i x)
-  (bytevector-ieee-single-native-set! v (+ i 4) x))
-(define-bytevector-type c32 c32 8)
-
-(define (bytevector-c64-ref v i)
-  (make-rectangular (bytevector-ieee-double-native-ref v i)
-                    (bytevector-ieee-double-native-ref v (+ i 8))))
-(define (bytevector-c64-set! v i x)
-  (bytevector-ieee-double-native-set! v i x)
-  (bytevector-ieee-double-native-set! v (+ i 8) x))
-(define-bytevector-type c64 c64 16)
-
-