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 <[email protected]> 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 <[email protected]> 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 <[email protected]> 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 <[email protected]> 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
