[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-192-g2f3b7e9

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=2f3b7e9a41677bfe802e8a1ee851827297384c58

The branch, stable-2.0 has been updated
       via  2f3b7e9a41677bfe802e8a1ee851827297384c58 (commit)
       via  85d3339d7e11c861e64bf2a4131fea8666ad8340 (commit)
       via  b5f9ba49db8e1ced6d70833b8104a266764a6537 (commit)
       via  a675a2e81b792b9f860bec57c38a1948631c7a41 (commit)
      from  9b5da400dde6e6bc8fd0e318e7ca1feffa5870db (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 2f3b7e9a41677bfe802e8a1ee851827297384c58
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 7 18:04:20 2014 +0100

    Fix truncated-print for uniform vectors
    
    * module/ice-9/pretty-print.scm (truncated-print): Use bytevector?
      instead of uniform-vector?; the latter could be true for shared arrays
      with non-zero lower bounds.

commit 85d3339d7e11c861e64bf2a4131fea8666ad8340
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 7 18:00:04 2014 +0100

    (srfi srfi-4 gnu) uses private define-bytevector-type from (srfi srfi-4)
    
    * module/srfi/srfi-4/gnu.scm: Re-use implementation of
      define-bytevector-type from srfi-4.

commit b5f9ba49db8e1ced6d70833b8104a266764a6537
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 7 17:57:30 2014 +0100

    Remove private unused duplicate c32/c64vector definitions
    
    * module/srfi/srfi-4.scm: Remove vestigial definitions for c32vectors
      and c64vectors.  Those are defined in (srfi srfi-4 gnu).

commit a675a2e81b792b9f860bec57c38a1948631c7a41
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 7 17:53:01 2014 +0100

    SRFI-4 predicates, length accessors only accept bytevectors (not arrays)
    
    * 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?.

-----------------------------------------------------------------------

Summary of changes:
 module/ice-9/pretty-print.scm |   11 +++++----
 module/srfi/srfi-4.scm        |   27 ++---------------------
 module/srfi/srfi-4/gnu.scm    |   45 +++-------------------------------------
 3 files changed, 13 insertions(+), 70 deletions(-)

diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 5c23cb0..6f54227 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -1,7 +1,7 @@
 ;;;; -*- coding: utf-8; mode: scheme -*-
 ;;;;
 ;;;;   Copyright (C) 2001, 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
@@ -20,6 +20,7 @@
 (define-module (ice-9 pretty-print)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (rnrs bytevectors)
   #:export (pretty-print
             truncated-print))
 
@@ -422,12 +423,12 @@ sub-expression, via the @var{breadth-first?} keyword 
argument."
             (display ")"))
            (else
             (display "#"))))
-         ((uniform-vector? x)
+         ((bytevector? x)
           (cond
            ((>= width 9)
-            (format #t  "#~a(" (uniform-vector-element-type x))
-            (print-sequence x (- width 6) (uniform-vector-length x)
-                            uniform-vector-ref identity)
+            (format #t  "#~a(" (array-type x))
+            (print-sequence x (- width 6) (array-length x)
+                            array-ref identity)
             (display ")"))
            (else
             (display "#"))))
diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index c6eb00b..b2e6f49 100644
--- 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
@@ -75,14 +75,11 @@
 (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))))
@@ -119,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)
-
-
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
index 7f595d6..42bbf33 100644
--- a/module/srfi/srfi-4/gnu.scm
+++ b/module/srfi/srfi-4/gnu.scm
@@ -1,6 +1,6 @@
 ;;; Extensions to SRFI-4
 
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 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
@@ -42,44 +42,6 @@
 
 (define make-srfi-4-vector (@@ (srfi srfi-4) make-srfi-4-vector))
 
-;; 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)))
-     (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))))
-         (if (integer? len)
-             len
-             (error "fractional length" v ',tag ,size))))
-     (define (,(symbol-append tag 'vector) . elts)
-       (,(symbol-append 'list-> tag 'vector) elts))
-     (define (,(symbol-append 'list-> tag 'vector) elts)
-       (let* ((len (length elts))
-              (v (,(symbol-append 'make- tag 'vector) len)))
-         (let lp ((i 0) (elts elts))
-           (if (and (< i len) (pair? elts))
-               (begin
-                 (,(symbol-append tag 'vector-set!) v i (car elts))
-                 (lp (1+ i) (cdr elts)))
-               v))))
-     (define (,(symbol-append tag 'vector->list) v)
-       (let lp ((i (1- (,(symbol-append tag 'vector-length) v))) (elts '()))
-         (if (< i 0)
-             elts
-             (lp (1- i) (cons (,(symbol-append tag 'vector-ref) v i) elts)))))
-     (define (,(symbol-append tag 'vector-ref) v i)
-       (,(symbol-append 'bytevector- infix '-ref) v (* i ,size)))
-     (define (,(symbol-append tag 'vector-set!) v i x)
-       (,(symbol-append 'bytevector- infix '-set!) v (* i ,size) x))
-     (define (,(symbol-append tag 'vector-set!) v i x)
-       (,(symbol-append 'bytevector- infix '-set!) v (* i ,size) x))))
-
 (define (bytevector-c32-native-ref v i)
   (make-rectangular (bytevector-ieee-single-native-ref v i)
                     (bytevector-ieee-single-native-ref v (+ i 4))))
@@ -92,8 +54,9 @@
 (define (bytevector-c64-native-set! v i x)
   (bytevector-ieee-double-native-set! v i (real-part x))
   (bytevector-ieee-double-native-set! v (+ i 8) (imag-part x)))
-(define-bytevector-type c32 c32-native 8)
-(define-bytevector-type c64 c64-native 16)
+
+((@@ (srfi srfi-4) define-bytevector-type) c32 c32-native 8)
+((@@ (srfi srfi-4) define-bytevector-type) c64 c64-native 16)
 
 (define-macro (define-any->vector . tags)
   `(begin


hooks/post-receive
-- 
GNU Guile