Merge commit '2f3b7e9a41'

Conflicts:
	module/ice-9/pretty-print.scm

module/ice-9/pretty-print.scm

@@ -1,7 +1,7 @@
 ;;;; -*- coding: utf-8; mode: scheme -*-
 ;;;;
 ;;;; 	Copyright (C) 2001, 2004, 2006, 2009, 2010,
-;;;;      2012, 2013 Free Software Foundation, Inc.
+;;;;      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
@@ -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))
 
@@ -418,12 +419,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 "#"))))

module/srfi/srfi-4.scm

@@ -116,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)
-
-

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