vectors are something else

vectors are something else

[Daniel Llorens]

After the array-map patches, I've gone through the vector/array implementation and there's some stuff I'd like to fix. In stable-2.0 today:

(define a (make-typed-array ''f64 0 '(1 2))
a
=> #1f64@1(0.0 0.0)

so far so good.

(uniform-vector? a)
=> #t

(f64vector-ref? a)
=> #t

so far so good.

(uniform-vector-ref a 0)
=> 0.0

This is a bug, since the valid indices are 1 and 2. This bug is in scm_c_generalized_vector_ref (and elsewhere):

pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc

this should be (to fix the bug: it shouldn't be written like this, but let's leave that aside for now)

pos = h.base + (idx - h.dims[0].lnbd) * h.dims[0].inc

Cf.

(vector-ref #@1(1 2 3 4) 1)
=> 2 (wrong)

but

(array-ref #@1(1 2 3 4) 1)
=> 1 (right)

I have patches for the above; however, the problems go well beyond.

(bitvector? (make-typed-array 'b #t 2))) => #t
(bitvector? (make-typed-array 'b #t '(1 2))) => #f
(bitvector-ref (make-typed-array 'b #t '(1 2))) => type error (consistent with #f)

(bytevector? (make-typed-array 's8 0 2))) => #t
(bytevector? (make-typed-array 's8 0 '(1 2))) => #f
(bytevector-ref (make-typed-array 's8 0 '(1 2))) => type error (consistent with #f)

(s8vector? (make-typed-array 's8 0 2))) => #t
(s8vector? (make-typed-array 's8 0 '(1 2))) => #t
(s8vector-ref (make-typed-array 's8 0 '(1 2))) => type error (inconsistent with #t)

(uniform-vector? (make-typed-array 's8 0 2))) => #t
(uniform-vector? (make-typed-array 's8 0 '(1 2))) => #t
(uniform-vector-ref (make-typed-array 's8 0 '(1 2))) => 0 (consistent with #t, but wrong)

(vector? (make-typed-array #t 0 2))) => #t
(vector? (make-typed-array #t 0 '(1 2))) => #f
(vector-ref (make-typed-array #t 0 '(1 2)) 0) => 0 (inconsistent with #f *and* wrong)

This is what I would like to do:

Force, and assume, inc and base to be 1 & 0 for uniform-vector / [srfi4type]vector / vector. That is, make all of the above behave as bitvector and bytevector. The advantanges are

a. the array implementation can rely on all these types having known base=0 and inc=1.
b. consistency.

Some programs may break, but they can't have relied on the behavior above without being broken already. Nobody has reported these bugs for a long time and the tests don't see them, I say we're good to go. 

Thoughts?

	Daniel

--

PS Some other, clearly worse, options:

1. Fix the bug above in uniform-vector-ref, etc. by having all the uniform-vector functions be aliases for array-ref. For consistency, do the same for bitvector- and bytevector- and srfi4vector- . Then all those functions pay the abstraction cost of using array- (which is not so much the rank as the type). It's also a fair amount of work. For example, the printer for uniform vectors depends on the first valid index being 0, so just fixing the buggy line above breaks the printer. The documentation does say that uniform-vectors are indexed from 0...

2. Fix the bug above in uniform-vector-ref, etc. by allowing inc!=1 and base!=0 for non-array objects. This will push some of the array functionality into bitvector, bytevector, etc (where inc=1 and base=0 are hardcoded) and generally complicate the code. Ditto for fixes required in other places.

3. Do 0, 1, or 2 differently for each of the vector types, e.g. Having srfi4vector- and uniform-vector- behave like bytevector-, but vector- behave like array-. Besides not making much sense, it would complicate the implementation of arrays (by which I mean, it wouldn't allow simplification that is sorely needed).

Re: vectors are something else

[Daniel Llorens]

On Apr 11, 2013, at 01:07, Daniel Llorens wrote:

> Force, and assume, inc and base to be 1 & 0 for uniform-vector / [srfi4type]vector / vector.

Correction: inc, base and lbnd to be 1, 0 and 0 is what I mean.

Re: vectors are something else

[Daniel Hartwig]

On 11 April 2013 07:07, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>
> After the array-map patches, I've gone through the vector/array implementation and there's some stuff I'd like to fix. In stable-2.0 today:
>
> (define a (make-typed-array ''f64 0 '(1 2))
> a
> => #1f64@1(0.0 0.0)
>
> so far so good.
>
> (uniform-vector? a)
> => #t
>
> (f64vector-ref? a)
> => #t
>
> so far so good.
>
> (uniform-vector-ref a 0)
> => 0.0
>
> This is a bug, since the valid indices are 1 and 2. This bug is in scm_c_generalized_vector_ref (and elsewhere):

For a vector, the valid indices are as specified by r5rs:

 The _valid indexes_ of a vector are the exact non-negative
 integers less than the length of the vector.  The first element in a
 vector is indexed by zero, and the last element is indexed by one less
 than the length of the vector.

which applies even when accessing arrays as vectors.  Offset indexing
is a feature of the array interface only.

Re: vectors are something else

[Daniel Llorens]

On Apr 12, 2013, at 01:53, Daniel Hartwig wrote:

> On 11 April 2013 07:07, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>> 
>> After the array-map patches, I've gone through the vector/array implementation and there's some stuff I'd like to fix. In stable-2.0 today:
>> 
>> (define a (make-typed-array ''f64 0 '(1 2))
>> a
>> => #1f64@1(0.0 0.0)
>> 
>> so far so good.
>> 
>> (uniform-vector? a)
>> => #t
>> 
>> (f64vector-ref? a)
>> => #t
>> 
>> so far so good.
>> 
>> (uniform-vector-ref a 0)
>> => 0.0
>> 
>> This is a bug, since the valid indices are 1 and 2. This bug is in scm_c_generalized_vector_ref (and elsewhere):
> 
> For a vector, the valid indices are as specified by r5rs:
> 
> The _valid indexes_ of a vector are the exact non-negative
> integers less than the length of the vector.  The first element in a
> vector is indexed by zero, and the last element is indexed by one less
> than the length of the vector.
> 
> which applies even when accessing arrays as vectors.  Offset indexing
> is a feature of the array interface only.

Right. I want [0]

(vector-ref #@1(1 2 3 4) 1) => 2

to fail with a type error, which is consistent with r5rs.

However my proposal is also to produce the same type error when the argument is a rank-1 array with base!=0 or inc!=1. These may be indexed from 0, but can only be produced by using the array interface, and use the array implementation internally. E.g. now you can do [1]

(vector-ref (make-shared-array #(1 2 3 4) (lambda (i) (list (* 2 i))) 2) 0) => 1 

which is 'correct' (and that object cannot be told apart from a plain vector using r5rs functions)

even though [2]

(vector? (make-shared-array #(1 2 3 4) (lambda (i) (list (* 2 i))) 2)) => #f

Forbidding [1] will break some programs. Yesterday it broke a program of mine where I was using vector-ref on an array which was a row in a rank 2 array. I think we have license to do this anyway because of [2] and because that's how the typed vectors work too (bitvector-, bytevector-).

The other option is to make [1] #t. But then, vector- is just an alias of array-. Might as well have (vector-ref #@1(1 2 3 4) 1) work properly.

This discussion came up months ago when the generalized-vector interface was deprecated. At that time, Andy Wingo wanted to keep [1] working or at least I that's what I understood. My motivation try this again now is to simplify the implementation of arrays.

Currently there is a chain of 4 function calls for a single use of array-ref (and I may have missed some). This is unacceptable. Also the vector and uniform-vector functions are all branched on whether the argument is internally a 'vector' or 'srfi4-vector' or not, which is the source of the inconsistencies I reported in the previous post. 

I'll send a patchset later today with at least the interface changes.

Regards,

	Daniel

Re: vectors are something else

[Daniel Hartwig]

On 12 April 2013 15:23, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>
> Right. I want [0]
>
> (vector-ref #@1(1 2 3 4) 1) => 2
>
> to fail with a type error, which is consistent with r5rs.
>

Ah.  I should have read more the later part of your mail.

> However my proposal is also to produce the same type error when
> the argument is a rank-1 array with base!=0 or inc!=1. These
> may be indexed from 0, but can only be produced by using the
> array interface, and use the array implementation
> internally.

I don't think this particular test is that useful, as it is too
concerned with the details of how the array indices map
to the underlying vector, rather than whether the array
indices themselves are compatible with the vector
indexing semantics.  Too restrictive IMO, you may as
well just not permit any array passed to vector
interfaces.

[Besides, you can already get at the underlying vector
using ‘shared-array-root’.]

> E.g. now you can do [1]
>
> (vector-ref (make-shared-array #(1 2 3 4) (lambda (i) (list (* 2 i))) 2) 0) => 1
>
> which is 'correct' (and that object cannot be told apart from a
> plain vector using r5rs functions)
>
> even though [2]
>
> (vector? (make-shared-array #(1 2 3 4) (lambda (i) (list (* 2 i))) 2)) => #f
>
> Forbidding [1] will break some programs. Yesterday it broke a
> program of mine where I was using vector-ref on an array which
> was a row in a rank 2 array. I think we have license to do this
> anyway because of [2] and because that's how the typed vectors
> work too (bitvector-, bytevector-).
>
> The other option is to make [2] #t. But then, vector- is just
> an alias of array-.

Sure, [1] and [2] should probably be consistent.

This does not make ‘vector-’ an alias however, as the semantics
of vector indexing must still be respected.  There are two layers
of indexing, vector (simple) and array (fancy).  For some objects
the two are compatible, like in [1].  For others like ‘#1@1(1 2)’
they are incompatible.  This compatibility is based on the
indices themselves, not how they are calculated (e.g ‘inc!=1’ is
not relevent for compatibility).

#1@1(a b c d) is:

 Element       a b c d
 Array index   1 2 3 4
 Vector index  0 1 2 3


There is some utility in permitting [1] where an arrays indices
are vector-compatible: array data (or a subset) can be passed to
a procedure expecting a vector without copying.

Is it worth the overhead to support this in the vector code?  I
think so, but then, haven't looked at the code :-)

Where an arrays indices are vector-incompatible, you can still
permit vector indexing of the elements by ignoring the array
indices (i.e. current ‘vector-ref’), or you can fail.  Failing
will result in less surprises.  This suggestion:

> Might as well have (vector-ref #@1(1 2 3 4) 1) work properly
> [by returning ‘1’ instead of ‘2’].

is not possible: the vector interface must use vector indexing
which means the first element of any object has index ‘0’.

It seems you prefer failing in the incompatible case, though I
have no strong preference either way.

For non-rank-1 arrays, the indices are clearly incompatible
though ‘array-contents’ already establishes a precedent for
the rank-1 ordering of the elements, and supporting that
case could be possible as well.


>
> This discussion came up months ago when the generalized-vector
> interface was deprecated. At that time, Andy Wingo wanted to
> keep [1] working or at least I that's what I understood. My
> motivation try this again now is to simplify the implementation
> of arrays.
>
> Currently there is a chain of 4 function calls for a single use
> of array-ref (and I may have missed some). This is
> unacceptable.

Perhaps.  I assume that ‘array-map!’ etc. are more efficient for
accessing multiple elements with the startup overhead is
amortized over all the elements.

> Also the vector and uniform-vector functions are
> all branched on whether the argument is internally a 'vector'
> or 'srfi4-vector' or not, which is the source of the
> inconsistencies I reported in the previous post.

Are those results from stable-2.0?  I do not reproduce some of
the type errors on my system, e.g.:

(bitvector-ref (make-typed-array 'b #t '(1 2)) 0) => #t


From your original mail:
> a. the array implementation can rely on all [vector] types
> having known base=0 and inc=1.

Is that not already the case?


Regards

Re: vectors are something else

[Daniel Hartwig]

On 12 April 2013 18:15, Daniel Hartwig <mandyke@gmail.com> wrote:
> From your original mail:
>> a. the array implementation can rely on all [vector] types
>> having known base=0 and inc=1.
>
> Is that not already the case?
>

Ah right, not when ‘vector?’ answers #t to compatible arrays.

Re: vectors are something else

[Daniel Llorens]

Message: 8
Date: Fri, 12 Apr 2013 18:15:05 +0800
From: Daniel Hartwig <mandyke@gmail.com>

> Too restrictive IMO, you may as
> well just not permit any array passed to vector
> interfaces.

Being restrictive would be my preference, yes.

> [Besides, you can already get at the underlying vector
> using ?shared-array-root?.]

That would cover your 'passing data without copying' scenario below, although admittedly only when inc=1.

> This compatibility is based on the
> indices themselves, not how they are calculated (e.g ?inc!=1? is
> not relevent for compatibility).

[0] This is true. It makes logical sense to allow rank-1 arrays with lbnd 0 to be accepted by the vector functions. I can go back on this. However, those permissive functions should be part of the array implementation, even if they are part of the vector interface. Same for the uniform-vector- functions. And live with the bytevector-ref inconsistency.

> #1@1(a b c d) is:
> 
> Element       a b c d
> Array index   1 2 3 4
> Vector index  0 1 2 3
> 
> There is some utility in permitting [1] where an arrays indices
> are vector-compatible: array data (or a subset) can be passed to
> a procedure expecting a vector without copying.

I think that allowing (vector-ref #1@1(a b c d) 0) is a logical error and it doesn't make sense to me as an extension. You can obtain a proper 0-indexed vector from this without copying by using make-shared-array (in the general case)

(make-shared-array #1@1(a b c d) (lambda (i) (list (+ i 1))) 4) => #(a b c d)

> Is it worth the overhead to support this in the vector code?  I
> think so, but then, haven't looked at the code :-)

The vector code can hardly support itself as it is :-(  

> This suggestion:
> 
>> Might as well have (vector-ref #@1(1 2 3 4) 1) work properly
>> [by returning ?1? instead of ?2?].
> 
> is not possible: the vector interface must use vector indexing
> which means the first element of any object has index ?0?.

Only true if that object is a vector; otherwise we can do whatever we want.

> For non-rank-1 arrays, the indices are clearly incompatible
> though ?array-contents? already establishes a precedent for
> the rank-1 ordering of the elements, and supporting that
> case could be possible as well.

array-contents doesn't work on general arrays, only on arrays that can be unrolled without copying. You can always unroll explicitly.

There can be an array-row-major-ref function, if somebody finds that useful. E.g. 

http://trac.sacrideo.us/wg/wiki/ArraysCowan

There's C interface for this in Guile. I'm against extending vector-ref to do it. Same for any other implicit unrolling as some NumPy functions do.

> Perhaps.  I assume that ?array-map!? etc. are more efficient for
> accessing multiple elements with the startup overhead is
> amortized over all the elements.

Unfortunately this is not so. The array-map functions are type generic and the type dispatch is done on each element access. Only the array handle access is amortized over each rank-1 section. This is something that I want to fix.

There are some vector functions that do type dispatch out of the inner loop, e.g. in libguile/random.c, and that's obviously how you would work with arrays in C outside of Guile.

I still think that array-ref shouldn't result in a chain of 4 nested calls.

> Are those results from stable-2.0?  I do not reproduce some of
> the type errors on my system, e.g.:
> 
> (bitvector-ref (make-typed-array 'b #t '(1 2)) 0) => #t

I've rebuilt and you are right, it must have been an older version.

>> a. the array implementation can rely on all [vector] types
>> having known base=0 and inc=1.
> 
> Is that not already the case?

It is, but for some reason the array functions don't make use of this fact. It's pretty confusing.

--

After [0], I'm open on allowing general, 0-indexed, rank-1 arrays to the vector- functions, but I'll send the patches anyway that forbid this. The tests all pass (which maybe shows how poor the coverage is).

It's should be simple to revert to the permissive vector- behavior (minus the bugs) if that's what we end up deciding.

Regards

	Daniel

Re: vectors are something else

[Daniel Hartwig]

On 12 April 2013 20:37, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:

[Tail first:]

> After [0], I'm open on allowing general, 0-indexed, rank-1
> arrays to the vector- functions, but I'll send the patches
> anyway that forbid this. The tests all pass (which maybe shows
> how poor the coverage is).
>

Great.  This strikes a nice balance, with simple enough semantics
and flexability to massage array data for vector-coded modules.
I doubt _anyone_ will miss using non-0-indexed arrays that way.

> It's should be simple to revert to the permissive vector-
> behavior (minus the bugs) if that's what we end up deciding.

Yes, bugs :-)


>
> Message: 8
> Date: Fri, 12 Apr 2013 18:15:05 +0800
> From: Daniel Hartwig <mandyke@gmail.com>
>
>> Too restrictive IMO, you may as
>> well just not permit any array passed to vector
>> interfaces.
>
> Being restrictive would be my preference, yes.
>
>> [Besides, you can already get at the underlying vector
>> using ?shared-array-root?.]
>
> That would cover your 'passing data without copying' scenario
> below, although admittedly only when inc=1.
>

Not so useful when you want to work with e.g. a subset of the
data.

>> This compatibility is based on the
>> indices themselves, not how they are calculated (e.g ?inc!=1? is
>> not relevent for compatibility).
>
>
> [0] This is true. It makes logical sense to allow rank-1 arrays
> with lbnd 0 to be accepted by the vector functions. I can go
> back on this.

This also matches the note in the manual about vectors being the
special case of rank-1 arrays.  It is implied that these are
0-indexed, rank-1 arrays.

> I think that allowing (vector-ref #1@1(a b c d) 0) is a logical
> error and it doesn't make sense to me as an extension.

We approached this from two different angles, based on whether
the object or the type defines the indices.

In any case, treating these non-0-indexed arrays as vectors is
a complicated semantic, that is difficult to justify and not
needed given:

> You can obtain a proper 0-indexed vector from this without
> copying by using make-shared-array (in the general case)
>
> (make-shared-array #1@1(a b c d)
>   (lambda (i) (list (+ i 1))) 4)
> => #(a b c d)
>


>> This suggestion:
>>
>>> Might as well have (vector-ref #@1(1 2 3 4) 1) work properly
>>> [by returning ?1? instead of ?2?].
>>
>> is not possible: the vector interface must use vector indexing
>> which means the first element of any object has index ?0?.
>
> Only true if that object is a vector; otherwise we can do whatever we want.
>

Ah.  Of course the vector interface is only (currently) specified
for vectors :-)

>> For non-rank-1 arrays, the indices are clearly incompatible
>> though ?array-contents? already establishes a precedent for
>> the rank-1 ordering of the elements, and supporting that
>> case could be possible as well.
>
> array-contents doesn't work on general arrays, only on arrays
> that can be unrolled without copying. You can always unroll
> explicitly.
>
> There can be an array-row-major-ref function, if somebody finds
> that useful. E.g.
>
> http://trac.sacrideo.us/wg/wiki/ArraysCowan
>

Neat.

> There's C interface for this in Guile. I'm against extending
> vector-ref to do it. Same for any other implicit unrolling as
> some NumPy functions do.
>

Right.  Best to keep interfaces simple and predictable.

Re: vectors are something else

[Mark H Weaver]

Daniel Hartwig <mandyke@gmail.com> writes:

> On 12 April 2013 15:23, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>>
>> However my proposal is also to produce the same type error when
>> the argument is a rank-1 array with base!=0 or inc!=1. These
>> may be indexed from 0, but can only be produced by using the
>> array interface, and use the array implementation
>> internally.
>
> I don't think this particular test is that useful, as it is too
> concerned with the details of how the array indices map
> to the underlying vector, rather than whether the array
> indices themselves are compatible with the vector
> indexing semantics.  Too restrictive IMO, you may as
> well just not permit any array passed to vector
> interfaces.

I've not yet had time to carefully read this thread, but I wanted to say
that I think we *should* prohibit passing arrays to the vector
interfaces.  When we have native code generation, then it will be
possible to make the vector procedures extremely simple machine code
sequences.  We must avoid adding any complications to this.  Even a
single additional conditional branch will be painful, in both runtime
overhead and code size.

If we were to support a subset of arrays to the vector interface, the
way it should be done is have the array constructors produce actual
vector objects when possible, or at least something that can be used by
the simple vector code sequences without any additional conditional
branches.

Does this make sense?

    Regards,
      Mark

Re: vectors are something else

[Daniel Llorens]

Date: Fri, 12 Apr 2013 22:06:38 +0800
From: Daniel Hartwig <mandyke@gmail.com>

> Great.  This strikes a nice balance, with simple enough semantics
> and flexability to massage array data for vector-coded modules.
> I doubt _anyone_ will miss using non-0-indexed arrays that way.

I personally think that offset indexing is a 100% useless feature and I'd happily drop it altogether from the array interface. But since it's there, it should work.

> This also matches the note in the manual about vectors being the
> special case of rank-1 arrays.  It is implied that these are
> 0-indexed, rank-1 arrays.

Yes, the manual does say the same thing about uniform vectors.

>> http://trac.sacrideo.us/wg/wiki/ArraysCowan
> 
> Neat.

To be honest, I don't like this interface too much. It seems based on early APL... of course Guile's is much smaller and is missing many things. We could pick up the obvious things, such as array-copy, array-reverse, array-reshape.

I'm sending the patches on a separate message.

Regards,

	Daniel

Re: vectors are something else

[Daniel Llorens]

[-- Attachment #1: Type: text/plain, Size: 4016 bytes --]


Hello,

I've written this patch set while trying to understand how arrays are implemented in Guile. It does the following things.

1. array objects (most things produced by the array interface) are never vector? or uniform-vector?

Therefore, basic functions such as vector-ref, vector-length, etc. will fail with a type error on these objects. This is the behavior of bytevector-; after the patches each of these sets gives the same result (#t, #f, type error, type error)

(import (rnrs bytevectors))
(define (every-two a) (make-shared-array a (lambda (i) (list (* i 2))) 2))

(bitvector? (make-typed-array 'b #t 2))
(bitvector? (make-typed-array 'b #t '(1 2)))
(bitvector-ref (make-typed-array 'b #t '(1 2)))
(bitvector-ref (every-two (make-typed-array 'b #t 4)) 0)   <--------- except for this one

(bytevector? (make-typed-array 's8 0 2))
(bytevector? (make-typed-array 's8 0 '(1 2)))
(bytevector-s8-ref (make-typed-array 's8 0 '(1 2)) 0)
(bytevector-s8-ref (every-two (make-typed-array 's8 0 4)) 0)

(s8vector? (make-typed-array 's8 0 2))
(s8vector? (make-typed-array 's8 0 '(1 2)))
(s8vector-ref (make-typed-array 's8 0 '(1 2)) 0)
(s8vector-ref (every-two (make-typed-array 's8 0 4)) 0)

(uniform-vector? (make-typed-array 's8 0 2))
(uniform-vector? (make-typed-array 's8 0 '(1 2)))
(uniform-vector-ref (make-typed-array 's8 0 '(1 2)) 0)
(uniform-vector-ref (every-two (make-typed-array 's8 0 4)) 0)

(vector? (make-typed-array #t 0 2))
(vector? (make-typed-array #t 0 '(1 2)))
(vector-ref (make-typed-array #t 0 '(1 2)) 0)
(vector-ref (every-two (make-typed-array #t 0 4)) 0)

After the discussion with Daniel Hartwig (not in this patchset), every fourth case would work as with bitvector. That's the behavior of stable-2.0 except for bytevector-s8-ref (& friends). In stable-2.0, the offset-1 cases are all broken except for bytevector-s8-ref (& friends).

2. Any object obtained from SCM_I_ARRAY_V is assumed to have base 0, inc 1, lbnd 0. This is true of all such objects (bitvector, bytevector, string and vector). This removes a bunch of redundant (and sometimes buggy) index computation in array-map.c, arrays.c, etc.

3. scm_array_get_handle places pointers to the underlying vector implementation in the array handle, so that is called directly instead of going through array_handle_ref and array_handle_set. This results in minor speedups of array-copy! and array-fill! and the following speedup of two-arg array-map!:

(define a (make-array 0. 1000000 10))
(define b (make-array 0. 1000000 10))
(define c (make-array *unspecified* 1000000 10))

before:

scheme@(guile-user)> ,time (array-map! c (lambda (a b) (+ a b)) a b)
;; 3.796000s real time, 3.780000s run time.  0.520000s spent in GC.

after:

scheme@(guile-user)> ,time (array-map! c (lambda (a b) (+ a b)) a b)
;; 2.789000s real time, 2.800000s run time.  0.310000s spent in GC.

These timings are still terrible though. The main benefit is that the impl-> call sequence is now easier to follow.

4. vectors are identified with 'simple vectors', so uses of simple-vector-ref and such have been replaced by vector-ref and such.

5. remove uses of most generalized-vector functions.

5. extra tests, bits and pieces, such as transpose-array now works with rank 0 arrays. 

All tests in stable-2.0 pass as they were.

I've seen at least a new bug: this fails at the repl after, it succeeded before.

scheme@(guile-user)> #1@1(1 2 3)
While compiling expression:
ERROR: Wrong type (expecting vector): #1@1(1 2 3)

However, this works fine:

scheme@(guile-user)> (call-with-input-string "#1@1(1 2 3)" read)
$3 = #1@1(1 2 3)

I haven't tried to debug this, but there're problems with the reader even in stable-2.0:

#b(#t #t) => error
#1b(#t #t) => ok
#b@1(#t #t) => error
#1b@1(#t #t) => ok

my understanding is that all of these should work, and the printer actually produces the versions it doesn't read.

Anyway, the patches.

Regards

	Daniel




[-- Attachment #2: 0001-Inline-generalized-vector-calls-in-array_handle_ref-.patch --]
[-- Type: application/octet-stream, Size: 1605 bytes --]

From 2c3a0a571e8e337e8b766da6e35d6285ae9457d8 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Sun, 7 Apr 2013 16:15:38 +0200
Subject: [PATCH 01/22] Inline generalized-vector calls in array_handle_ref/set

* libguile/arrays.c: (array-handle-ref, array-handle-set): Ditto.
---
 libguile/arrays.c | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 1eb10b9..350da44 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -816,15 +816,25 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
 }
 
 static SCM
-array_handle_ref (scm_t_array_handle *h, size_t pos)
+array_handle_ref (scm_t_array_handle *hh, size_t pos)
 {
-  return scm_c_generalized_vector_ref (SCM_I_ARRAY_V (h->array), pos);
+  scm_t_array_handle h;
+  SCM ret;
+  scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
+  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  ret = h.impl->vref (&h, pos);
+  scm_array_handle_release (&h);
+  return ret;
 }
 
 static void
-array_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
 {
-  scm_c_generalized_vector_set_x (SCM_I_ARRAY_V (h->array), pos, val);
+  scm_t_array_handle h;
+  scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
+  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  h.impl->vset (&h, pos, val);
+  scm_array_handle_release (&h);
 }
 
 /* FIXME: should be handle for vect? maybe not, because of dims */
-- 
1.8.2


[-- Attachment #3: 0002-Don-t-use-generalized-vector-functions-in-uniform.c.patch --]
[-- Type: application/octet-stream, Size: 5488 bytes --]

From 8e9f0507df78fa13bc5c556bd2bebf7d93d78d06 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Mon, 8 Apr 2013 13:13:21 +0200
Subject: [PATCH 02/22] Don't use generalized-vector functions in uniform.c

* libguile/uniform.c
  - (scm_is_uniform_vector): replace scm_is_generalized_vector and
    scm_generalized_vector_get_handle by scm_is_array and manual rank check.
  - (scm_c_uniform_vector_length): inline length computation. This
    removes a redundant rank check.
  - (scm_c_uniform_vector_ref): inline impl->vref use. This removes
    a redundant rank check.
  - (scm_c_uniform_vector_set): inline impl->vset use. This removes
    a redundant rank check.
  - (scm_uniform_vector_writable_elements): replace
    scm_generalized_vector_get_handle by scm_array_get_handle.

* test-suite/test/arrays.test
  - rename uniform-vector-ref block to uniform-vector.
  - exercise uniform-vector-length and shared arrays remaining uniform.
---
 libguile/uniform.c           | 41 +++++++++++++++++++++++++++++++----------
 test-suite/tests/arrays.test | 24 ++++++++++++++++++++----
 2 files changed, 51 insertions(+), 14 deletions(-)

diff --git a/libguile/uniform.c b/libguile/uniform.c
index a58242d..26193a3 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -87,10 +87,11 @@ scm_is_uniform_vector (SCM obj)
   scm_t_array_handle h;
   int ret = 0;
 
-  if (scm_is_generalized_vector (obj))
+  if (scm_is_array (obj))
     {
-      scm_generalized_vector_get_handle (obj, &h);
-      ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
+      scm_array_get_handle (obj, &h);
+      ret = 1 == scm_array_handle_rank (&h)
+            && SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
       scm_array_handle_release (&h);
     }
   return ret;
@@ -99,11 +100,16 @@ scm_is_uniform_vector (SCM obj)
 size_t
 scm_c_uniform_vector_length (SCM uvec)
 {
+  scm_t_array_handle h;
+  size_t ret;
   if (!scm_is_uniform_vector (uvec))
     scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
                             "uniform vector");
 
-  return scm_c_generalized_vector_length (uvec);
+  scm_array_get_handle (uvec, &h);
+  ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+  scm_array_handle_release (&h);
+  return ret;
 }
 
 SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
@@ -150,11 +156,20 @@ SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0
 #undef FUNC_NAME
 
 SCM
-scm_c_uniform_vector_ref (SCM v, size_t idx)
+scm_c_uniform_vector_ref (SCM v, size_t pos)
 {
+  scm_t_array_handle h;
+  SCM ret;
+
   if (!scm_is_uniform_vector (v))
     scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
-  return scm_c_generalized_vector_ref (v, idx);
+
+  scm_array_get_handle (v, &h);
+  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  ret = h.impl->vref (&h, pos);
+  scm_array_handle_release (&h);
+  return ret;
+
 }
 
 SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
@@ -168,11 +183,17 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
 #undef FUNC_NAME
 
 void
-scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
+scm_c_uniform_vector_set_x (SCM v, size_t pos, SCM val)
 {
+  scm_t_array_handle h;
+
   if (!scm_is_uniform_vector (v))
     scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
-  scm_c_generalized_vector_set_x (v, idx, val);
+
+  scm_array_get_handle (v, &h);
+  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  h.impl->vset (&h, pos, val);
+  scm_array_handle_release (&h);
 }
 
 SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
@@ -206,12 +227,12 @@ scm_uniform_vector_elements (SCM uvec,
 }
 
 void *
-scm_uniform_vector_writable_elements (SCM uvec, 
+scm_uniform_vector_writable_elements (SCM uvec,
 				      scm_t_array_handle *h,
 				      size_t *lenp, ssize_t *incp)
 {
   void *ret;
-  scm_generalized_vector_get_handle (uvec, h);
+  scm_array_get_handle (uvec, h);
   /* FIXME nonlocal exit */
   ret = scm_array_handle_uniform_writable_elements (h);
   if (lenp)
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 0b3d57c..9d86371 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -574,12 +574,12 @@
 	   (eqv? 8 (array-ref s2 2))))))
 
 ;;;
-;;; uniform-vector-ref
+;;; uniform-vector
 ;;;
 
-(with-test-prefix "uniform-vector-ref"
+(with-test-prefix "uniform-vector"
 
-  (with-test-prefix "byte"
+  (with-test-prefix "uniform-vector-ref byte"
 
     (let ((a (make-s8vector 1)))
 
@@ -594,7 +594,23 @@
       (pass-if "-128"
 	(begin
 	  (array-set! a -128 0)
-	  (= -128 (uniform-vector-ref a 0)))))))
+	  (= -128 (uniform-vector-ref a 0))))))
+
+  (with-test-prefix "shared with rank 1 remain uniform vectors"
+
+    (let ((a #f64(1 2 3 4)))
+
+      (pass-if "change offset"
+        (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
+          (and (uniform-vector? b)
+               (= 3 (uniform-vector-length b))
+               (array-equal? b #f64(2 3 4)))))
+
+      (pass-if "change stride"
+        (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+          (and (uniform-vector? c)
+               (= 2 (uniform-vector-length c))
+               (array-equal? c #f64(1 3))))))))
 
 ;;;
 ;;; syntax
-- 
1.8.2


[-- Attachment #4: 0003-Don-t-use-generalized-vector-in-array-map.c-I.patch --]
[-- Type: application/octet-stream, Size: 6144 bytes --]

From 9fe3e2aa6d515699e3f96b38f65b1741c229e90b Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Mon, 8 Apr 2013 13:34:41 +0200
Subject: [PATCH 03/22] Don't use generalized-vector in array-map.c (I)

* array-map.c: (AREF, ASET): new internal functions replace
  scm_c_generalized_vector_ref/set. These remove a redundant check for
  rank in the generalized_vector set.
---
 libguile/array-map.c | 58 +++++++++++++++++++++++++++++++++-------------------
 1 file changed, 37 insertions(+), 21 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 1c443ac..2aa4d56 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -48,9 +48,28 @@
 /* The WHAT argument for `scm_gc_malloc ()' et al.  */
 static const char indices_gc_hint[] = "array-indices";
 
+/* FIXME Versions of array_handle_ref/set in arrays.c */
+static SCM
+AREF (SCM v, size_t pos)
+{
+  scm_t_array_handle h;
+  SCM ret;
+  scm_array_get_handle (v, &h);
+  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  ret = h.impl->vref (&h, pos);
+  scm_array_handle_release (&h);
+  return ret;
+}
 
-#define GVREF scm_c_generalized_vector_ref
-#define GVSET scm_c_generalized_vector_set_x
+static void
+ASET (SCM v, size_t pos, SCM val)
+{
+  scm_t_array_handle h;
+  scm_array_get_handle (v, &h);
+  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  h.impl->vset (&h, pos, val);
+  scm_array_handle_release (&h);
+}
 
 static unsigned long
 cind (SCM ra, long *ve)
@@ -407,7 +426,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
   ra = SCM_I_ARRAY_V (ra);
 
   for (i = base; n--; i += inc)
-    GVSET (ra, i, fill);
+    ASET (ra, i, fill);
 
   return 1;
 }
@@ -437,7 +456,7 @@ scm_ra_eqp (SCM ra0, SCM ras)
   {
     for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
       if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
-	if (!scm_is_eq (GVREF (ra1, i1), GVREF (ra2, i2)))
+	if (!scm_is_eq (AREF (ra1, i1), AREF (ra2, i2)))
 	  scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
   }
 
@@ -470,8 +489,8 @@ ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
     for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
       if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
 	if (opt ?
-	    scm_is_true (scm_less_p (GVREF (ra1, i1), GVREF (ra2, i2))) :
-	    scm_is_false (scm_less_p (GVREF (ra1, i1), GVREF (ra2, i2))))
+	    scm_is_true (scm_less_p (AREF (ra1, i1), AREF (ra2, i2))) :
+	    scm_is_false (scm_less_p (AREF (ra1, i1), AREF (ra2, i2))))
 	  scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
   }
 
@@ -527,7 +546,7 @@ scm_ra_sum (SCM ra0, SCM ras)
 	default:
 	  {
 	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      GVSET (ra0, i0, scm_sum (GVREF(ra0, i0), GVREF(ra1, i1)));
+	      ASET (ra0, i0, scm_sum (AREF(ra0, i0), AREF(ra1, i1)));
 	    break;
 	  }
 	}
@@ -551,7 +570,7 @@ scm_ra_difference (SCM ra0, SCM ras)
 	default:
 	  {
 	    for (; n-- > 0; i0 += inc0)
-	      GVSET (ra0, i0, scm_difference (GVREF(ra0, i0), SCM_UNDEFINED));
+	      ASET (ra0, i0, scm_difference (AREF(ra0, i0), SCM_UNDEFINED));
 	    break;
 	  }
 	}
@@ -567,8 +586,7 @@ scm_ra_difference (SCM ra0, SCM ras)
 	default:
 	  {
 	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      GVSET (ra0, i0, scm_difference (GVREF (ra0, i0),
-					      GVREF (ra1, i1)));
+	      ASET (ra0, i0, scm_difference (AREF (ra0, i0), AREF (ra1, i1)));
 	    break;
 	  }
 	}
@@ -596,8 +614,7 @@ scm_ra_product (SCM ra0, SCM ras)
 	default:
 	  {
 	    for (; n-- > 0; i0 += inc0, i1 += inc1)
-	      GVSET (ra0, i0, scm_product (GVREF (ra0, i0),
-					   GVREF (ra1, i1)));
+	      ASET (ra0, i0, scm_product (AREF (ra0, i0), AREF (ra1, i1)));
 	  }
 	}
     }
@@ -619,7 +636,7 @@ scm_ra_divide (SCM ra0, SCM ras)
 	default:
 	  {
 	    for (; n-- > 0; i0 += inc0)
-	      GVSET (ra0, i0, scm_divide (GVREF (ra0, i0), SCM_UNDEFINED));
+	      ASET (ra0, i0, scm_divide (AREF (ra0, i0), SCM_UNDEFINED));
 	    break;
 	  }
 	}
@@ -636,9 +653,8 @@ scm_ra_divide (SCM ra0, SCM ras)
 	  {
 	    for (; n-- > 0; i0 += inc0, i1 += inc1)
 	      {
-		SCM res =  scm_divide (GVREF (ra0, i0),
-				       GVREF (ra1, i1));
-		GVSET (ra0, i0, res);
+		SCM res =  scm_divide (AREF (ra0, i0), AREF (ra1, i1));
+		ASET (ra0, i0, res);
 	      }
 	    break;
 	  }
@@ -693,7 +709,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
               SCM args = SCM_EOL;
               unsigned long k;
               for (k = scm_c_vector_length (ras); k--;)
-                args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+                args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
               h0.impl->vset (&h0, i0, scm_apply_1 (proc, h1.impl->vref (&h1, i1), args));
             }
         }
@@ -753,7 +769,7 @@ rafe (SCM ra0, SCM proc, SCM ras)
           SCM args = SCM_EOL;
           unsigned long k;
           for (k = scm_c_vector_length (ras); k--;)
-            args = scm_cons (GVREF (scm_c_vector_ref (ras, k), i), args);
+            args = scm_cons (AREF (scm_c_vector_ref (ras, k), i), args);
           scm_apply_1 (proc, h0.impl->vref (&h0, i0), args);
         }
     }
@@ -823,7 +839,7 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
 		{
 		  for (j = kmax + 1, args = SCM_EOL; j--;)
 		    args = scm_cons (scm_from_long (vinds[j]), args);
-		  GVSET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
+		  ASET (SCM_I_ARRAY_V (ra), i, scm_apply_0 (proc, args));
 		  i += SCM_I_ARRAY_DIMS (ra)[k].inc;
 		}
 	      k--;
@@ -846,10 +862,10 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
     {
       size_t length = scm_c_generalized_vector_length (ra);
       for (i = 0; i < length; i++)
-	GVSET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
+	ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
       return SCM_UNSPECIFIED;
     }
-  else 
+  else
     scm_wrong_type_arg_msg (NULL, 0, ra, "array");
 }
 #undef FUNC_NAME
-- 
1.8.2


[-- Attachment #5: 0004-Don-t-use-generalized-vector-in-array-map.c-II.patch --]
[-- Type: application/octet-stream, Size: 4023 bytes --]

From b5bb76841000ff10dfca0d6e5b02b05817eaa9c6 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 9 Apr 2013 16:57:16 +0200
Subject: [PATCH 04/22] Don't use generalized-vector in array-map.c (II)

* libguile/array-map.c
  - replace scm_is_generalized_vector by scm_is_array && !SCM_I_ARRAY_P.
  - replace scm_c_generalized_vector_length by scm_c_array_length.
  - remove header.
---
 libguile/array-map.c | 49 ++++++++++++++++++++++++-------------------------
 1 file changed, 24 insertions(+), 25 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 2aa4d56..8484d8c 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -39,7 +39,6 @@
 #include "libguile/bitvectors.h"
 #include "libguile/srfi-4.h"
 #include "libguile/generalized-arrays.h"
-#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
 #include "libguile/array-map.h"
@@ -104,34 +103,34 @@ scm_ra_matchp (SCM ra0, SCM ras)
   int i, ndim = 1;
   int exact = 2	  /* 4 */ ;  /* Don't care about values >2 (yet?) */
 
-  if (scm_is_generalized_vector (ra0))
+  if (!scm_is_array (ra0))
+      return 0;
+  else if (!SCM_I_ARRAYP (ra0))
     {
       s0->lbnd = 0;
       s0->inc = 1;
-      s0->ubnd = scm_c_generalized_vector_length (ra0) - 1;
+      s0->ubnd = scm_c_array_length (ra0) - 1;
     }
-  else if (SCM_I_ARRAYP (ra0))
+  else
     {
       ndim = SCM_I_ARRAY_NDIM (ra0);
       s0 = SCM_I_ARRAY_DIMS (ra0);
       bas0 = SCM_I_ARRAY_BASE (ra0);
     }
-  else
-    return 0;
 
   while (SCM_NIMP (ras))
     {
       ra1 = SCM_CAR (ras);
-      
-      if (scm_is_generalized_vector (ra1))
+
+      if (!SCM_I_ARRAYP (ra1))
 	{
 	  size_t length;
-	  
+
 	  if (1 != ndim)
 	    return 0;
-	  
-	  length = scm_c_generalized_vector_length (ra1);
-	  
+
+	  length = scm_c_array_length (ra1);
+
 	  switch (exact)
 	    {
 	    case 4:
@@ -149,7 +148,7 @@ scm_ra_matchp (SCM ra0, SCM ras)
 		return 0;
 	    }
 	}
-      else if (SCM_I_ARRAYP (ra1) && ndim == SCM_I_ARRAY_NDIM (ra1))
+      else if (ndim == SCM_I_ARRAY_NDIM (ra1))
 	{
 	  s1 = SCM_I_ARRAY_DIMS (ra1);
 	  if (bas0 != SCM_I_ARRAY_BASE (ra1))
@@ -213,7 +212,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
       if (SCM_IMP (vra0)) goto gencase;
       if (!SCM_I_ARRAYP (vra0))
 	{
-	  size_t length = scm_c_generalized_vector_length (vra0);
+	  size_t length = scm_c_array_length (vra0);
 	  vra1 = scm_i_make_array (1);
 	  SCM_I_ARRAY_BASE (vra1) = 0;
 	  SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
@@ -271,7 +270,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
       }
     else
       {
-	size_t length = scm_c_generalized_vector_length (ra0);
+	size_t length = scm_c_array_length (ra0);
 	kmax = 0;
 	SCM_I_ARRAY_DIMS (vra0)->lbnd = 0;
 	SCM_I_ARRAY_DIMS (vra0)->ubnd = length - 1;
@@ -814,7 +813,16 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
   unsigned long i;
   SCM_VALIDATE_PROC (2, proc);
 
-  if (SCM_I_ARRAYP (ra))
+  if (!scm_is_array (ra))
+    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
+  else if (!SCM_I_ARRAYP (ra))
+    {
+      size_t length = scm_c_array_length (ra);
+      for (i = 0; i < length; ++i)
+	ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
+      return SCM_UNSPECIFIED;
+    }
+  else
     {
       SCM args = SCM_EOL;
       int j, k, kmax = SCM_I_ARRAY_NDIM (ra) - 1;
@@ -858,15 +866,6 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0,
 
       return SCM_UNSPECIFIED;
     }
-  else if (scm_is_generalized_vector (ra))
-    {
-      size_t length = scm_c_generalized_vector_length (ra);
-      for (i = 0; i < length; i++)
-	ASET (ra, i, scm_call_1 (proc, scm_from_ulong (i)));
-      return SCM_UNSPECIFIED;
-    }
-  else
-    scm_wrong_type_arg_msg (NULL, 0, ra, "array");
 }
 #undef FUNC_NAME
 
-- 
1.8.2


[-- Attachment #6: 0005-Replace-scm_c_generalized_vector_length-in-random.c.patch --]
[-- Type: application/octet-stream, Size: 1291 bytes --]

From 89327a0c65d232dce47876fe309f971005046da5 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 9 Apr 2013 18:09:49 +0200
Subject: [PATCH 05/22] Replace scm_c_generalized_vector_length in random.c

* libguile/random.c: (random:solid-sphere!): array is of known
  rank 1, so use scm_c_array_length() instead.
---
 libguile/random.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/libguile/random.c b/libguile/random.c
index c0b04bc..6df2cd9 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -582,13 +582,13 @@ SCM_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0,
   scm_random_normal_vector_x (v, state);
   vector_scale_x (v,
 		  pow (scm_c_uniform01 (SCM_RSTATE (state)),
-		       1.0 / scm_c_generalized_vector_length (v))
+		       1.0 / scm_c_array_length (v))
 		  / sqrt (vector_sum_squares (v)));
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0, 
+SCM_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0,
             (SCM v, SCM state),
             "Fills vect with inexact real random numbers\n"
             "the sum of whose squares is equal to 1.0.\n"
-- 
1.8.2


[-- Attachment #7: 0006-Replace-scm_c_generalized_vector_length-in-arrays.c.patch --]
[-- Type: application/octet-stream, Size: 1848 bytes --]

From b3fd45ad958d2f3f5305489225a6ef6103309eed Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 9 Apr 2013 18:17:21 +0200
Subject: [PATCH 06/22] Replace scm_c_generalized_vector_length in arrays.c

* libguile/arrays.c: (scm_array_contents, scm_make_shared_array):
  arrays are known of rank 1 so replace by scm_c_array_length.
---
 libguile/arrays.c | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 350da44..15f67fd 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -378,7 +378,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
     {
       SCM_I_ARRAY_V (ra) = oldra;
       old_base = old_min = 0;
-      old_max = scm_c_generalized_vector_length (oldra) - 1;
+      old_max = scm_c_array_length (oldra) - 1;
     }
 
   inds = SCM_EOL;
@@ -430,7 +430,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
   if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
     {
       SCM v = SCM_I_ARRAY_V (ra);
-      size_t length = scm_c_generalized_vector_length (v);
+      size_t length = scm_c_array_length (v);
       if (1 == s->inc && 0 == s->lbnd && length == 1 + s->ubnd)
 	return v;
       if (s->ubnd < s->lbnd)
@@ -583,14 +583,14 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
 		return SCM_BOOL_F;
 	    }
 	}
-      
+
       {
 	SCM v = SCM_I_ARRAY_V (ra);
-	size_t length = scm_c_generalized_vector_length (v);
+	size_t length = scm_c_array_length (v);
 	if ((len == length) && 0 == SCM_I_ARRAY_BASE (ra) && SCM_I_ARRAY_DIMS (ra)->inc)
 	  return v;
       }
-      
+
       sra = scm_i_make_array (1);
       SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
       SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
-- 
1.8.2


[-- Attachment #8: 0007-Remove-generalized-vectors.h-includes.patch --]
[-- Type: application/octet-stream, Size: 960 bytes --]

From f06acc15a1a2980eb44c6a9a8c7f1315fc8c5ea6 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Tue, 9 Apr 2013 18:27:29 +0200
Subject: [PATCH 07/22] Remove generalized-vectors.h includes

* libguile/srfi-4.c, libguile/uniform.h: ditto.
---
 libguile/srfi-4.c  | 1 -
 libguile/uniform.h | 1 -
 2 files changed, 2 deletions(-)

diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index af8126d..6e005b1 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -31,7 +31,6 @@
 #include "libguile/eval.h"
 #include "libguile/extensions.h"
 #include "libguile/uniform.h"
-#include "libguile/generalized-vectors.h"
 #include "libguile/validate.h"
 
 
diff --git a/libguile/uniform.h b/libguile/uniform.h
index f0d5915..ccc52a8 100644
--- a/libguile/uniform.h
+++ b/libguile/uniform.h
@@ -24,7 +24,6 @@
 \f
 
 #include "libguile/__scm.h"
-#include "libguile/generalized-vectors.h"
 
 \f
 
-- 
1.8.2


[-- Attachment #9: 0008-Remove-unnecessary-condition-in-scm_make_typed_array.patch --]
[-- Type: application/octet-stream, Size: 957 bytes --]

From efa6103613f087c4a8a3e6d21985e8e359729dea Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 01:07:02 +0200
Subject: [PATCH 08/22] Remove unnecessary condition in scm_make_typed_array

* libguile/arrays.c: NDIM = 1 guarantees that s->inc == 1. Remove condition.
---
 libguile/arrays.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 15f67fd..9b242a1 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -195,8 +195,9 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
     scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
 
   if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-    if (s->ubnd < s->lbnd || (0 == s->lbnd && 1 == s->inc))
+    if (s->ubnd < s->lbnd || 0 == s->lbnd)
       return SCM_I_ARRAY_V (ra);
+
   return ra;
 }
 #undef FUNC_NAME
-- 
1.8.2


[-- Attachment #10: 0009-Tests-for-shared-array-root.patch --]
[-- Type: application/octet-stream, Size: 1736 bytes --]

From 048c47cf327b6cb43ec3b69f4f3222428d151624 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 13:45:05 +0200
Subject: [PATCH 09/22] Tests for shared-array-root

* test-suite/tests/arrays.test: check shared-array-root against
  make-shared-array, array-contents.
---
 test-suite/tests/arrays.test | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 9d86371..1353927 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -574,6 +574,35 @@
 	   (eqv? 8 (array-ref s2 2))))))
 
 ;;;
+;;; shared-array-root
+;;;
+
+(with-test-prefix "shared-array-root"
+
+  (define amap1 (lambda (i) (list (* 2 i))))
+  (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
+
+  (pass-if "plain vector"
+    (let* ((a (make-vector 4 0))
+           (b (make-shared-array a amap1 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+  (pass-if "plain array rank 2"
+    (let* ((a (make-array 0 4 4))
+           (b (make-shared-array a amap2 2 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+  (pass-if "uniform array rank 2"
+    (let* ((a (make-typed-array 'c64 0 4 4))
+           (b (make-shared-array a amap2 2 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+  (pass-if "bit array rank 2"
+    (let* ((a (make-typed-array 'b #f 4 4))
+           (b (make-shared-array a amap2 2 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
+
+;;;
 ;;; uniform-vector
 ;;;
 
-- 
1.8.2


[-- Attachment #11: 0010-Don-t-use-scm_is_generalized_vector-in-shared-array-.patch --]
[-- Type: application/octet-stream, Size: 1593 bytes --]

From 549594ee5f5556ee6ecb3a3c4ac1421364e7f3d5 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 13:48:13 +0200
Subject: [PATCH 10/22] Don't use scm_is_generalized_vector in
 shared-array-root

* libguile/arrays.c: (scm_shared_array_root): replace check for
  scm_is_generalized_vector.
---
 libguile/arrays.c | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 9b242a1..3f73107 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -60,21 +60,22 @@
   (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
 
 
-SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, 
+SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
            (SCM ra),
 	    "Return the root vector of a shared array.")
 #define FUNC_NAME s_scm_shared_array_root
 {
-  if (SCM_I_ARRAYP (ra))
+  if (!scm_is_array (ra))
+    scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
+  else if (SCM_I_ARRAYP (ra))
     return SCM_I_ARRAY_V (ra);
-  else if (scm_is_generalized_vector (ra))
+  else
     return ra;
-  scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, 
+SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0,
            (SCM ra),
 	    "Return the root vector index of the first element in the array.")
 #define FUNC_NAME s_scm_shared_array_offset
-- 
1.8.2


[-- Attachment #12: 0011-Tests-for-transpose-array.patch --]
[-- Type: application/octet-stream, Size: 1846 bytes --]

From 2de78692e2159e8ec3de6f8556a8da57a5a88bf7 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 14:53:10 +0200
Subject: [PATCH 11/22] Tests for transpose-array

* test-suite/tests/arrays.test: test transpose-array for ranks 1, 2, 3.
---
 test-suite/tests/arrays.test | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 1353927..c3a28c5 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -603,6 +603,38 @@
       (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
 
 ;;;
+;;; transpose-array
+;;;
+
+(with-test-prefix "transpose-array"
+
+  (pass-if "rank 1"
+    (let* ((a #(1 2 3))
+           (b (transpose-array a 0)))
+      (and (array-equal? a b)
+           (eq? (shared-array-root a) (shared-array-root b)))))
+
+  (pass-if "rank 2"
+    (let* ((a #2((1 2 3) (4 5 6)))
+           (b (transpose-array a 1 0))
+           (c (transpose-array a 0 1)))
+      (and (array-equal? b #2((1 4) (2 5) (3 6)))
+           (array-equal? c a)
+           (eq? (shared-array-root a)
+                (shared-array-root b)
+                (shared-array-root c)))))
+
+  ; rank > 2 is needed to check against the inverted axis index logic.
+  (pass-if "rank 3"
+    (let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
+                 ((12 13 14 15) (16 17 18 19) (20 21 22 23))))
+           (b (transpose-array a 1 2 0)))
+      (and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
+                              ((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
+           (eq? (shared-array-root a)
+                (shared-array-root b))))))
+
+;;;
 ;;; uniform-vector
 ;;;
 
-- 
1.8.2


[-- Attachment #13: 0012-Don-t-use-scm_is_generalized_vector-in-transpose-arr.patch --]
[-- Type: application/octet-stream, Size: 2660 bytes --]

From 95511997d48dc2922fe515de7b963b411d85e0b1 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 15:11:33 +0200
Subject: [PATCH 12/22] Don't use scm_is_generalized_vector in transpose-array

* libguile/arrays.c (scm_transpose_array)
  - Use scm_c_array_rank(), which contains an implicit is_array test.
  - Handle the rank 0 case.
* test-suite/tests/arrays.test
  - Add test for rank 0 case.
  - Add failure test for non array argument.
---
 libguile/arrays.c            | 16 ++++++++--------
 test-suite/tests/arrays.test | 13 +++++++++++++
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 3f73107..695ab78 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -476,20 +476,22 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
   SCM_VALIDATE_REST_ARGUMENT (args);
   SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
 
-  if (scm_is_generalized_vector (ra))
+  switch (scm_c_array_rank (ra))
     {
+    case 0:
+      if (!scm_is_null (args))
+	SCM_WRONG_NUM_ARGS ();
+      return ra;
+    case 1:
       /* Make sure that we are called with a single zero as
-	 arguments. 
+	 arguments.
       */
       if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))
 	SCM_WRONG_NUM_ARGS ();
       SCM_VALIDATE_INT_COPY (SCM_ARG2, SCM_CAR (args), i);
       SCM_ASSERT_RANGE (SCM_ARG2, SCM_CAR (args), i == 0);
       return ra;
-    }
-
-  if (SCM_I_ARRAYP (ra))
-    {
+    default:
       vargs = scm_vector (args);
       if (SCM_SIMPLE_VECTOR_LENGTH (vargs) != SCM_I_ARRAY_NDIM (ra))
 	SCM_WRONG_NUM_ARGS ();
@@ -539,8 +541,6 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
       scm_i_ra_set_contp (res);
       return res;
     }
-
-  scm_wrong_type_arg_msg (NULL, 0, ra, "array");
 }
 #undef FUNC_NAME
 
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index c3a28c5..600c295 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -606,8 +606,21 @@
 ;;; transpose-array
 ;;;
 
+; see strings.test.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
 (with-test-prefix "transpose-array"
 
+  (pass-if-exception "non array argument" exception:wrong-type-arg
+    (transpose-array 99))
+
+  (pass-if "rank 0"
+    (let* ((a #0(99))
+           (b (transpose-array a)))
+      (and (array-equal? a b)
+           (eq? (shared-array-root a) (shared-array-root b)))))
+
   (pass-if "rank 1"
     (let* ((a #(1 2 3))
            (b (transpose-array a 0)))
-- 
1.8.2


[-- Attachment #14: 0013-Reorder-arrays.test.patch --]
[-- Type: application/octet-stream, Size: 11771 bytes --]

From 60e793100c43e3ad62031b5b0b542f1457351f7b Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Wed, 10 Apr 2013 15:28:52 +0200
Subject: [PATCH 13/22] Reorder arrays.test

* test-suite/tests/arrays.test: dependence reordering: first sanity, then
  make-array, then array-equal?, then make-shared-array, shared-array-root,
  then the rest, many of which use make-shared-array.
---
 test-suite/tests/arrays.test | 304 +++++++++++++++++++++----------------------
 1 file changed, 152 insertions(+), 152 deletions(-)

diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 600c295..0da1a19 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -6,12 +6,12 @@
 ;;;; modify it under the terms of the GNU Lesser General Public
 ;;;; License as published by the Free Software Foundation; either
 ;;;; version 3 of the License, or (at your option) any later version.
-;;;; 
+;;;;
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;;;; Lesser General Public License for more details.
-;;;; 
+;;;;
 ;;;; You should have received a copy of the GNU Lesser General Public
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
@@ -207,6 +207,154 @@
     (array-equal? #s16(1 2 3) #s16(1 2 3))))
 
 ;;;
+;;; make-shared-array
+;;;
+
+(define exception:mapping-out-of-range
+  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
+
+(with-test-prefix "make-shared-array"
+
+  ;; this failed in guile 1.8.0
+  (pass-if "vector unchanged"
+    (let* ((a (make-array #f '(0 7)))
+	   (s (make-shared-array a list '(0 7))))
+      (array-equal? a s)))
+
+  (pass-if-exception "vector, high too big" exception:mapping-out-of-range
+    (let* ((a (make-array #f '(0 7))))
+      (make-shared-array a list '(0 8))))
+
+  (pass-if-exception "vector, low too big" exception:out-of-range
+    (let* ((a (make-array #f '(0 7))))
+      (make-shared-array a list '(-1 7))))
+
+  (pass-if "truncate columns"
+    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
+		  #2((a b) (d e) (g h))))
+
+  (pass-if "pick one column"
+    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+				     (lambda (i) (list i 2))
+				     '(0 2))
+		  #(c f i)))
+
+  (pass-if "diagonal"
+    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+				     (lambda (i) (list i i))
+				     '(0 2))
+		  #(a e i)))
+
+  ;; this failed in guile 1.8.0
+  (pass-if "2 dims from 1 dim"
+    (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
+				     (lambda (i j) (list (+ (* i 3) j)))
+				     4 3)
+		  #2((a b c) (d e f) (g h i) (j k l))))
+
+  (pass-if "reverse columns"
+    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
+				     (lambda (i j) (list i (- 2 j)))
+				     3 3)
+		  #2((c b a) (f e d) (i h g))))
+
+  (pass-if "fixed offset, 0 based becomes 1 based"
+    (let* ((x #2((a b c) (d e f) (g h i)))
+	   (y (make-shared-array x
+				 (lambda (i j) (list (1- i) (1- j)))
+				 '(1 3) '(1 3))))
+      (and (eq? (array-ref x 0 0) 'a)
+	   (eq? (array-ref y 1 1) 'a))))
+
+  ;; this failed in guile 1.8.0
+  (pass-if "stride every third element"
+    (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
+				     (lambda (i) (list (* i 3)))
+				     4)
+		  #1(a d g j)))
+
+  (pass-if "shared of shared"
+    (let* ((a  #2((1 2 3) (4 5 6) (7 8 9)))
+	   (s1 (make-shared-array a (lambda (i) (list i 1)) 3))
+	   (s2 (make-shared-array s1 list '(1 2))))
+      (and (eqv? 5 (array-ref s2 1))
+	   (eqv? 8 (array-ref s2 2))))))
+
+;;;
+;;; shared-array-root
+;;;
+
+(with-test-prefix "shared-array-root"
+
+  (define amap1 (lambda (i) (list (* 2 i))))
+  (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
+
+  (pass-if "plain vector"
+    (let* ((a (make-vector 4 0))
+           (b (make-shared-array a amap1 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+  (pass-if "plain array rank 2"
+    (let* ((a (make-array 0 4 4))
+           (b (make-shared-array a amap2 2 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+  (pass-if "uniform array rank 2"
+    (let* ((a (make-typed-array 'c64 0 4 4))
+           (b (make-shared-array a amap2 2 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
+
+  (pass-if "bit array rank 2"
+    (let* ((a (make-typed-array 'b #f 4 4))
+           (b (make-shared-array a amap2 2 2)))
+      (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
+
+;;;
+;;; transpose-array
+;;;
+
+; see strings.test.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
+(with-test-prefix "transpose-array"
+
+  (pass-if-exception "non array argument" exception:wrong-type-arg
+    (transpose-array 99))
+
+  (pass-if "rank 0"
+    (let* ((a #0(99))
+           (b (transpose-array a)))
+      (and (array-equal? a b)
+           (eq? (shared-array-root a) (shared-array-root b)))))
+
+  (pass-if "rank 1"
+    (let* ((a #(1 2 3))
+           (b (transpose-array a 0)))
+      (and (array-equal? a b)
+           (eq? (shared-array-root a) (shared-array-root b)))))
+
+  (pass-if "rank 2"
+    (let* ((a #2((1 2 3) (4 5 6)))
+           (b (transpose-array a 1 0))
+           (c (transpose-array a 0 1)))
+      (and (array-equal? b #2((1 4) (2 5) (3 6)))
+           (array-equal? c a)
+           (eq? (shared-array-root a)
+                (shared-array-root b)
+                (shared-array-root c)))))
+
+  ; rank > 2 is needed to check against the inverted axis index logic.
+  (pass-if "rank 3"
+    (let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
+                 ((12 13 14 15) (16 17 18 19) (20 21 22 23))))
+           (b (transpose-array a 1 2 0)))
+      (and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
+                              ((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
+           (eq? (shared-array-root a)
+                (shared-array-root b))))))
+
+;;;
 ;;; array->list
 ;;;
 
@@ -397,8 +545,8 @@
       (for-each (lambda (type)
 		  (pass-if (symbol->string type)
 		     (eq? type
-			  (array-type (make-typed-array type 
-							*unspecified* 
+			  (array-type (make-typed-array type
+							*unspecified*
 							'(5 6))))))
 		types))))
 
@@ -500,154 +648,6 @@
 	(array-set! a 'y 4 8 0)))))
 
 ;;;
-;;; make-shared-array
-;;;
-
-(define exception:mapping-out-of-range
-  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
-
-(with-test-prefix "make-shared-array"
-
-  ;; this failed in guile 1.8.0
-  (pass-if "vector unchanged"
-    (let* ((a (make-array #f '(0 7)))
-	   (s (make-shared-array a list '(0 7))))
-      (array-equal? a s)))
-
-  (pass-if-exception "vector, high too big" exception:mapping-out-of-range
-    (let* ((a (make-array #f '(0 7))))
-      (make-shared-array a list '(0 8))))
-
-  (pass-if-exception "vector, low too big" exception:out-of-range
-    (let* ((a (make-array #f '(0 7))))
-      (make-shared-array a list '(-1 7))))
-
-  (pass-if "truncate columns"
-    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
-		  #2((a b) (d e) (g h))))
-
-  (pass-if "pick one column"
-    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
-				     (lambda (i) (list i 2))
-				     '(0 2))
-		  #(c f i)))
-
-  (pass-if "diagonal"
-    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
-				     (lambda (i) (list i i))
-				     '(0 2))
-		  #(a e i)))
-
-  ;; this failed in guile 1.8.0
-  (pass-if "2 dims from 1 dim"
-    (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
-				     (lambda (i j) (list (+ (* i 3) j)))
-				     4 3)
-		  #2((a b c) (d e f) (g h i) (j k l))))
-
-  (pass-if "reverse columns"
-    (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
-				     (lambda (i j) (list i (- 2 j)))
-				     3 3)
-		  #2((c b a) (f e d) (i h g))))
-
-  (pass-if "fixed offset, 0 based becomes 1 based"
-    (let* ((x #2((a b c) (d e f) (g h i)))
-	   (y (make-shared-array x
-				 (lambda (i j) (list (1- i) (1- j)))
-				 '(1 3) '(1 3))))
-      (and (eq? (array-ref x 0 0) 'a)
-	   (eq? (array-ref y 1 1) 'a))))
-
-  ;; this failed in guile 1.8.0
-  (pass-if "stride every third element"
-    (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
-				     (lambda (i) (list (* i 3)))
-				     4)
-		  #1(a d g j)))
-
-  (pass-if "shared of shared"
-    (let* ((a  #2((1 2 3) (4 5 6) (7 8 9)))
-	   (s1 (make-shared-array a (lambda (i) (list i 1)) 3))
-	   (s2 (make-shared-array s1 list '(1 2))))
-      (and (eqv? 5 (array-ref s2 1))
-	   (eqv? 8 (array-ref s2 2))))))
-
-;;;
-;;; shared-array-root
-;;;
-
-(with-test-prefix "shared-array-root"
-
-  (define amap1 (lambda (i) (list (* 2 i))))
-  (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
-
-  (pass-if "plain vector"
-    (let* ((a (make-vector 4 0))
-           (b (make-shared-array a amap1 2)))
-      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
-
-  (pass-if "plain array rank 2"
-    (let* ((a (make-array 0 4 4))
-           (b (make-shared-array a amap2 2 2)))
-      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
-
-  (pass-if "uniform array rank 2"
-    (let* ((a (make-typed-array 'c64 0 4 4))
-           (b (make-shared-array a amap2 2 2)))
-      (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
-
-  (pass-if "bit array rank 2"
-    (let* ((a (make-typed-array 'b #f 4 4))
-           (b (make-shared-array a amap2 2 2)))
-      (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
-
-;;;
-;;; transpose-array
-;;;
-
-; see strings.test.
-(define exception:wrong-type-arg
-  (cons #t "Wrong type"))
-
-(with-test-prefix "transpose-array"
-
-  (pass-if-exception "non array argument" exception:wrong-type-arg
-    (transpose-array 99))
-
-  (pass-if "rank 0"
-    (let* ((a #0(99))
-           (b (transpose-array a)))
-      (and (array-equal? a b)
-           (eq? (shared-array-root a) (shared-array-root b)))))
-
-  (pass-if "rank 1"
-    (let* ((a #(1 2 3))
-           (b (transpose-array a 0)))
-      (and (array-equal? a b)
-           (eq? (shared-array-root a) (shared-array-root b)))))
-
-  (pass-if "rank 2"
-    (let* ((a #2((1 2 3) (4 5 6)))
-           (b (transpose-array a 1 0))
-           (c (transpose-array a 0 1)))
-      (and (array-equal? b #2((1 4) (2 5) (3 6)))
-           (array-equal? c a)
-           (eq? (shared-array-root a)
-                (shared-array-root b)
-                (shared-array-root c)))))
-
-  ; rank > 2 is needed to check against the inverted axis index logic.
-  (pass-if "rank 3"
-    (let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
-                 ((12 13 14 15) (16 17 18 19) (20 21 22 23))))
-           (b (transpose-array a 1 2 0)))
-      (and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
-                              ((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
-           (eq? (shared-array-root a)
-                (shared-array-root b))))))
-
-;;;
 ;;; uniform-vector
 ;;;
 
-- 
1.8.2


[-- Attachment #15: 0014-Fix-bad-uses-of-base-and-lbnd-on-rank-1-arrays.patch --]
[-- Type: application/octet-stream, Size: 7020 bytes --]

From 9663f407aa5b0c3fef2b52a413cb95df2b303b8e Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 13:03:45 +0200
Subject: [PATCH 14/22] Fix bad uses of base and lbnd on rank 1 arrays

 * libguile/array-map.c
   - rafill, ramap, rafe, racp: object from SCM_I_ARRAY_V always
     has base 0, lbnd 0 and inc 1; make use of this.
 * libguile/arrays.c
   - array_handle_ref, array_handle_set: idem.
   - array_get_handle: sanity check.
 * libguile/generalized-vectors.c
   - scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x:
     pos should be base when idx is lbnd. Furthermore, pos should be signed and
     have its overflow checked; do this by handling the job to
     scm_c_array_ref_1, scm_c_array_set_1_x.
 * libguile/generalized-vectors.h
   - fix prototypes.
---
 libguile/array-map.c           | 27 +++++++++++++--------------
 libguile/arrays.c              |  8 ++++++--
 libguile/generalized-vectors.c | 20 ++++----------------
 libguile/generalized-vectors.h |  4 ++--
 4 files changed, 25 insertions(+), 34 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 8484d8c..426103c 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -194,9 +194,8 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
   SCM lvra, *plvra;
   long *vinds;
   int k, kmax;
-  int (*cproc) ();
+  int (*cproc) () = cproc_ptr;
 
-  cproc = cproc_ptr;
   switch (scm_ra_matchp (ra0, lra))
     {
     default:
@@ -344,8 +343,8 @@ rafill (SCM dst, SCM fill)
   size_t i;
   ssize_t inc;
   scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
-  i = h.base + h.dims[0].lbnd + SCM_I_ARRAY_BASE (dst)*h.dims[0].inc;
-  inc = SCM_I_ARRAY_DIMS (dst)->inc * h.dims[0].inc;
+  i = SCM_I_ARRAY_BASE (dst);
+  inc = SCM_I_ARRAY_DIMS (dst)->inc;
 
   for (; n-- > 0; i += inc)
     h.impl->vset (&h, i, fill);
@@ -378,10 +377,10 @@ racp (SCM src, SCM dst)
   scm_array_get_handle (SCM_I_ARRAY_V (src), &h_s);
   scm_array_get_handle (SCM_I_ARRAY_V (dst), &h_d);
 
-  i_s = h_s.base + h_s.dims[0].lbnd + SCM_I_ARRAY_BASE (src) * h_s.dims[0].inc;
-  i_d = h_d.base + h_d.dims[0].lbnd + SCM_I_ARRAY_BASE (dst) * h_d.dims[0].inc;
-  inc_s = SCM_I_ARRAY_DIMS (src)->inc * h_s.dims[0].inc;
-  inc_d = SCM_I_ARRAY_DIMS (dst)->inc * h_d.dims[0].inc;
+  i_s = SCM_I_ARRAY_BASE (src);
+  i_d = SCM_I_ARRAY_BASE (dst);
+  inc_s = SCM_I_ARRAY_DIMS (src)->inc;
+  inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
 
   for (; n-- > 0; i_s += inc_s, i_d += inc_d)
     h_d.impl->vset (&h_d, i_d, h_s.impl->vref (&h_s, i_s));
@@ -681,8 +680,8 @@ ramap (SCM ra0, SCM proc, SCM ras)
   size_t i0, i0end;
   ssize_t inc0;
   scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
-  i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
-  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+  i0 = SCM_I_ARRAY_BASE (ra0);
+  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
   i0end = i0 + n*inc0;
   if (scm_is_null (ras))
     for (; i0 < i0end; i0 += inc0)
@@ -694,8 +693,8 @@ ramap (SCM ra0, SCM proc, SCM ras)
       size_t i1;
       ssize_t inc1;
       scm_array_get_handle (SCM_I_ARRAY_V (ra1), &h1);
-      i1 = h1.base + h1.dims[0].lbnd + SCM_I_ARRAY_BASE (ra1)*h1.dims[0].inc;
-      inc1 = SCM_I_ARRAY_DIMS (ra1)->inc * h1.dims[0].inc;
+      i1 = SCM_I_ARRAY_BASE (ra1);
+      inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
       ras = SCM_CDR (ras);
       if (scm_is_null (ras))
           for (; i0 < i0end; i0 += inc0, i1 += inc1)
@@ -754,8 +753,8 @@ rafe (SCM ra0, SCM proc, SCM ras)
   size_t i0, i0end;
   ssize_t inc0;
   scm_array_get_handle (SCM_I_ARRAY_V (ra0), &h0);
-  i0 = h0.base + h0.dims[0].lbnd + SCM_I_ARRAY_BASE (ra0)*h0.dims[0].inc;
-  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc * h0.dims[0].inc;
+  i0 = SCM_I_ARRAY_BASE (ra0);
+  inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
   i0end = i0 + n*inc0;
   if (scm_is_null (ras))
     for (; i0 < i0end; i0 += inc0)
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 695ab78..191d02d 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -823,7 +823,6 @@ array_handle_ref (scm_t_array_handle *hh, size_t pos)
   scm_t_array_handle h;
   SCM ret;
   scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
-  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
   ret = h.impl->vref (&h, pos);
   scm_array_handle_release (&h);
   return ret;
@@ -834,7 +833,6 @@ array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
 {
   scm_t_array_handle h;
   scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
-  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
   h.impl->vset (&h, pos, val);
   scm_array_handle_release (&h);
 }
@@ -845,6 +843,12 @@ array_get_handle (SCM array, scm_t_array_handle *h)
 {
   scm_t_array_handle vh;
   scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
+  if (vh.dims[0].inc != 1 || vh.dims[0].lbnd != 0 || vh.base != 0)
+    {
+      fprintf(stderr, "INC %ld, %ld", vh.dims[0].inc, vh.dims[0].lbnd);
+      fflush(stderr);
+      abort();
+    }
   h->element_type = vh.element_type;
   h->elements = vh.elements;
   h->writable_elements = vh.writable_elements;
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 5e3e552..6e88f3c 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -110,27 +110,15 @@ scm_c_generalized_vector_length (SCM v)
 }
 
 SCM
-scm_c_generalized_vector_ref (SCM v, size_t idx)
+scm_c_generalized_vector_ref (SCM v, ssize_t idx)
 {
-  scm_t_array_handle h;
-  size_t pos;
-  SCM ret;
-  scm_generalized_vector_get_handle (v, &h);
-  pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc;
-  ret = h.impl->vref (&h, pos);
-  scm_array_handle_release (&h);
-  return ret;
+  return scm_c_array_ref_1(v, idx);
 }
 
 void
-scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
+scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val)
 {
-  scm_t_array_handle h;
-  size_t pos;
-  scm_generalized_vector_get_handle (v, &h);
-  pos = h.base + h.dims[0].lbnd + idx * h.dims[0].inc;
-  h.impl->vset (&h, pos, val);
-  scm_array_handle_release (&h);
+  scm_c_array_set_1_x(v, val, idx);
 }
 
 void
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
index e2acb98..876537a 100644
--- a/libguile/generalized-vectors.h
+++ b/libguile/generalized-vectors.h
@@ -32,8 +32,8 @@
 
 SCM_API int scm_is_generalized_vector (SCM obj);
 SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
+SCM_API SCM scm_c_generalized_vector_ref (SCM v, ssize_t idx);
+SCM_API void scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val);
 SCM_API void scm_generalized_vector_get_handle (SCM vec,
 						scm_t_array_handle *h);
 
-- 
1.8.2


[-- Attachment #16: 0015-For-uniform-vectors-SCM_I_ARRAYP-can-t-be-true.patch --]
[-- Type: application/octet-stream, Size: 6067 bytes --]

From db6f9b83f1c21aa22446c3d644e5df68f7a0bdc8 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 13:10:08 +0200
Subject: [PATCH 15/22] For uniform vectors SCM_I_ARRAYP can't be true

This fixes an inconsistency where uniform-vector? of a shared array could
be true but -ref operations failed to account correctly for lbnd.

* libguile/uniform.c
  - scm_is_uniform_vector: SCM_I_ARRAYP disqualifies obj as uniform vector.
  - scm_c_uniform_vector_length: lbnd is known 0, so don't use it.
  - scm_c_uniform_vector_ref: lbnd/base/inc are known to be 0/0/1.
  - scm_c_uniform_vector_set_x!: idem.
  - scm_uniform_vector_writable_elements: check uvec's type.
* test-suite/tests/arrays.test
  - group the exception types at the top.
  - check that uniform-vector functions do not accept general arrays.
---
 libguile/uniform.c           | 11 ++++-----
 test-suite/tests/arrays.test | 58 +++++++++++++++++++++++++++-----------------
 2 files changed, 41 insertions(+), 28 deletions(-)

diff --git a/libguile/uniform.c b/libguile/uniform.c
index 26193a3..dc6c024 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -87,11 +87,10 @@ scm_is_uniform_vector (SCM obj)
   scm_t_array_handle h;
   int ret = 0;
 
-  if (scm_is_array (obj))
+  if (scm_is_array (obj) && !SCM_I_ARRAYP (obj))
     {
       scm_array_get_handle (obj, &h);
-      ret = 1 == scm_array_handle_rank (&h)
-            && SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
+      ret = SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type);
       scm_array_handle_release (&h);
     }
   return ret;
@@ -107,7 +106,7 @@ scm_c_uniform_vector_length (SCM uvec)
                             "uniform vector");
 
   scm_array_get_handle (uvec, &h);
-  ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+  ret = h.dims[0].ubnd + 1;
   scm_array_handle_release (&h);
   return ret;
 }
@@ -165,7 +164,6 @@ scm_c_uniform_vector_ref (SCM v, size_t pos)
     scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
 
   scm_array_get_handle (v, &h);
-  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
   ret = h.impl->vref (&h, pos);
   scm_array_handle_release (&h);
   return ret;
@@ -191,7 +189,6 @@ scm_c_uniform_vector_set_x (SCM v, size_t pos, SCM val)
     scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
 
   scm_array_get_handle (v, &h);
-  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
   h.impl->vset (&h, pos, val);
   scm_array_handle_release (&h);
 }
@@ -232,6 +229,8 @@ scm_uniform_vector_writable_elements (SCM uvec,
 				      size_t *lenp, ssize_t *incp)
 {
   void *ret;
+  if (!scm_is_uniform_vector (uvec))
+    scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector");
   scm_array_get_handle (uvec, h);
   /* FIXME nonlocal exit */
   ret = scm_array_handle_uniform_writable_elements (h);
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 0da1a19..8ad97f4 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -22,16 +22,22 @@
   #:use-module (srfi srfi-4)
   #:use-module (srfi srfi-4 gnu))
 
-;;;
-;;; array?
-;;;
-
 (define exception:wrong-num-indices
   (cons 'misc-error "^wrong number of indices.*"))
 
 (define exception:length-non-negative
   (cons 'read-error ".*array length must be non-negative.*"))
 
+(define exception:mapping-out-of-range
+  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
+
+; see strings.test.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
+;;;
+;;; array?
+;;;
 
 (with-test-prefix "sanity"
   ;; At the current time of writing, bignums have a tc7 that is one bit
@@ -210,9 +216,6 @@
 ;;; make-shared-array
 ;;;
 
-(define exception:mapping-out-of-range
-  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
-
 (with-test-prefix "make-shared-array"
 
   ;; this failed in guile 1.8.0
@@ -313,10 +316,6 @@
 ;;; transpose-array
 ;;;
 
-; see strings.test.
-(define exception:wrong-type-arg
-  (cons #t "Wrong type"))
-
 (with-test-prefix "transpose-array"
 
   (pass-if-exception "non array argument" exception:wrong-type-arg
@@ -670,21 +669,36 @@
 	  (array-set! a -128 0)
 	  (= -128 (uniform-vector-ref a 0))))))
 
-  (with-test-prefix "shared with rank 1 remain uniform vectors"
+  (with-test-prefix "arrays with lbnd!=0 are not uniform vectors"
+
+    (pass-if "bit"
+      (and (not (uniform-vector? #1b@1(#t #t #t)))
+           (uniform-vector? #1b(#t #t #t))))
+
+    (pass-if "s8"
+      (and (not (uniform-vector? #1s8@1(0 1 2)))
+           (uniform-vector? #1s8(0 1 2)))))
+
+
+  (with-test-prefix "shared with rank 1 do not remain uniform vectors"
 
     (let ((a #f64(1 2 3 4)))
 
-      (pass-if "change offset"
+      (pass-if-exception "change offset -length" exception:wrong-type-arg
         (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
-          (and (uniform-vector? b)
-               (= 3 (uniform-vector-length b))
-               (array-equal? b #f64(2 3 4)))))
-
-      (pass-if "change stride"
-        (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
-          (and (uniform-vector? c)
-               (= 2 (uniform-vector-length c))
-               (array-equal? c #f64(1 3))))))))
+          (= 3 (uniform-vector-length b))))
+
+      (pass-if-exception "change offset -ref" exception:wrong-type-arg
+        (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
+          (= 2 (uniform-vector-ref b 0))))
+
+      (pass-if-exception "change stride -length" exception:wrong-type-arg
+        (let ((b (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+          (= 3 (uniform-vector-length b))))
+
+      (pass-if-exception "change stride -ref" exception:wrong-type-arg
+        (let ((b (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+          (= 2 (uniform-vector-ref b 0)))))))
 
 ;;;
 ;;; syntax
-- 
1.8.2


[-- Attachment #17: 0016-Identify-scm_is_vector-with-scm_is_simple_vector.patch --]
[-- Type: application/octet-stream, Size: 14342 bytes --]

From 523838b40230a4f358ace69b4dfd05c2f3eec770 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 18:11:35 +0200
Subject: [PATCH 16/22] Identify scm_is_vector with scm_is_simple_vector

This patch fixes the bug (vector-ref #1@1(1 2 3) 1) => 2.

* libguile/vectors.c: (scm_is_vector): just as scm_is_simple_vector.
* libguile/filesys.c, libguile/random.c, libguile/stime.c, libguile/trees.c,
  libguile/validate.h: use scm_is_vector instead of scm_is_simple_vector.
* libguile/sort.c
  - scm_restricted_vector_sort_x: use scm_array_handle_writable_elements
    instead of scm_vector_writable_elements, to work with non-vector
    rank-1 array objects.
  - scm_sort_x: check for scm_is_array instead of scm_is_vector. Rank
    check is in restricted_vector_sort_x.
  - scm_sort: ditto.
  - scm_stable_sort_x: like scm_restricted_vector_sort_x.
  - scm_stable_sort: like scm_sort.
* test-suite/tests/arrays.test: fix header.
* test-suite/tests/random.test: new coverage test covering
  random:normal-vector!
* test-suite/Makefile.am: include random.test in make check.
---
 libguile/filesys.c           | 10 ++++----
 libguile/random.c            |  6 ++---
 libguile/sort.c              | 57 +++++++++++++++++++++++++-------------------
 libguile/stime.c             |  2 +-
 libguile/trees.c             |  4 ++--
 libguile/validate.h          |  4 ++--
 libguile/vectors.c           |  9 +------
 test-suite/Makefile.am       |  1 +
 test-suite/tests/arrays.test |  2 +-
 test-suite/tests/random.test | 55 ++++++++++++++++++++++++++++++++++++++++++
 10 files changed, 103 insertions(+), 47 deletions(-)
 create mode 100644 test-suite/tests/random.test

diff --git a/libguile/filesys.c b/libguile/filesys.c
index 5f6208d..c7aaed7 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -691,7 +691,7 @@ fill_select_type (fd_set *set, SCM *ports_ready, SCM list_or_vec, int pos)
 {
   int max_fd = 0;
 
-  if (scm_is_simple_vector (list_or_vec))
+  if (scm_is_vector (list_or_vec))
     {
       int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
       
@@ -752,7 +752,7 @@ retrieve_select_type (fd_set *set, SCM ports_ready, SCM list_or_vec)
 {
   SCM answer_list = ports_ready;
 
-  if (scm_is_simple_vector (list_or_vec))
+  if (scm_is_vector (list_or_vec))
     {
       int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);
 
@@ -821,7 +821,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
   SCM write_ports_ready = SCM_EOL;
   int max_fd;
 
-  if (scm_is_simple_vector (reads))
+  if (scm_is_vector (reads))
     {
       read_count = SCM_SIMPLE_VECTOR_LENGTH (reads);
     }
@@ -830,7 +830,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
       read_count = scm_ilength (reads);
       SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME);
     }
-  if (scm_is_simple_vector (writes))
+  if (scm_is_vector (writes))
     {
       write_count = SCM_SIMPLE_VECTOR_LENGTH (writes);
     }
@@ -839,7 +839,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
       write_count = scm_ilength (writes);
       SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME);
     }
-  if (scm_is_simple_vector (excepts))
+  if (scm_is_vector (excepts))
     {
       except_count = SCM_SIMPLE_VECTOR_LENGTH (excepts);
     }
diff --git a/libguile/random.c b/libguile/random.c
index 6df2cd9..915f17f 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -504,7 +504,7 @@ static void
 vector_scale_x (SCM v, double c)
 {
   size_t n;
-  if (scm_is_simple_vector (v))
+  if (scm_is_vector (v))
     {
       n = SCM_SIMPLE_VECTOR_LENGTH (v);
       while (n-- > 0)
@@ -532,7 +532,7 @@ vector_sum_squares (SCM v)
 {
   double x, sum = 0.0;
   size_t n;
-  if (scm_is_simple_vector (v))
+  if (scm_is_vector (v))
     {
       n = SCM_SIMPLE_VECTOR_LENGTH (v);
       while (n-- > 0)
@@ -626,7 +626,7 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
   scm_generalized_vector_get_handle (v, &handle);
   dim = scm_array_handle_dims (&handle);
 
-  if (scm_is_vector (v))
+  if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM)
     {
       SCM *elts = scm_array_handle_writable_elements (&handle);
       for (i = dim->lbnd; i <= dim->ubnd; i++, elts += dim->inc)
diff --git a/libguile/sort.c b/libguile/sort.c
index 2a36320..1b47afc 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -77,18 +77,25 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
 #define FUNC_NAME s_scm_restricted_vector_sort_x
 {
   size_t vlen, spos, len;
-  ssize_t vinc;
   scm_t_array_handle handle;
+  scm_t_array_dim *dim;
+
   SCM *velts;
 
-  velts = scm_vector_writable_elements (vec, &handle, &vlen, &vinc);
+  if (!scm_is_array (vec) || 1 != scm_c_array_rank (vec))
+      SCM_WRONG_TYPE_ARG (1, vec);
+
+  scm_array_get_handle (vec, &handle);
+  velts = scm_array_handle_writable_elements (&handle);
+  dim = scm_array_handle_dims (&handle);
+  vlen = dim->ubnd - dim->lbnd + 1;
   spos = scm_to_unsigned_integer (startpos, 0, vlen);
   len = scm_to_unsigned_integer (endpos, spos, vlen) - spos;
 
-  if (vinc == 1)
-    quicksort1 (velts + spos*vinc, len, less);
+  if (dim->inc == 1)
+    quicksort1 (velts + spos, len, less);
   else
-    quicksort (velts + spos*vinc, len, vinc, less);
+    quicksort (velts + spos*dim->inc, len, dim->inc, less);
 
   scm_array_handle_release (&handle);
 
@@ -377,12 +384,12 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0,
       SCM_VALIDATE_LIST_COPYLEN (1, items, len);
       return scm_merge_list_step (&items, less, len);
     }
-  else if (scm_is_vector (items))
+  else if (scm_is_array (items))
     {
       scm_restricted_vector_sort_x (items,
 				    less,
 				    scm_from_int (0),
-				    scm_vector_length (items));
+				    scm_array_length (items));
       return items;
     }
   else
@@ -403,7 +410,7 @@ SCM_DEFINE (scm_sort, "sort", 2, 0, 0,
 
   if (scm_is_pair (items))
     return scm_sort_x (scm_list_copy (items), less);
-  else if (scm_is_vector (items))
+  else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
     return scm_sort_x (scm_vector_copy (items), less);
   else
     SCM_WRONG_TYPE_ARG (1, items);
@@ -489,28 +496,30 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
       SCM_VALIDATE_LIST_COPYLEN (1, items, len);
       return scm_merge_list_step (&items, less, len);
     }
-  else if (scm_is_vector (items))
+  else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
     {
-      scm_t_array_handle temp_handle, vec_handle;
-      SCM temp, *temp_elts, *vec_elts;
+      scm_t_array_handle temp_handle, items_handle;
+      scm_t_array_dim *dim;
+      SCM temp, *temp_elts, *items_elts;
       size_t len;
-      ssize_t inc;
-      
-      vec_elts = scm_vector_writable_elements (items, &vec_handle,
-					       &len, &inc);
+
+      scm_array_get_handle (items, &items_handle);
+      items_elts = scm_array_handle_writable_elements (&items_handle);
+      dim = scm_array_handle_dims (&items_handle);
+      len = dim->ubnd - dim->lbnd + 1;
       if (len == 0) {
-        scm_array_handle_release (&vec_handle);
+        scm_array_handle_release (&items_handle);
         return items;
       }
-      
+
       temp = scm_c_make_vector (len, SCM_UNDEFINED);
-      temp_elts = scm_vector_writable_elements (temp, &temp_handle,
-						NULL, NULL);
+      scm_array_get_handle (temp, &temp_handle);
+      temp_elts = scm_array_handle_writable_elements (&temp_handle);
 
-      scm_merge_vector_step (vec_elts, temp_elts, less, 0, len-1, inc);
+      scm_merge_vector_step (items_elts, temp_elts, less, 0, len-1, dim->inc);
 
       scm_array_handle_release (&temp_handle);
-      scm_array_handle_release (&vec_handle);
+      scm_array_handle_release (&items_handle);
 
       return items;
     }
@@ -532,15 +541,13 @@ SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
 
   if (scm_is_pair (items))
     return scm_stable_sort_x (scm_list_copy (items), less);
-  else if (scm_is_vector (items))
-    return scm_stable_sort_x (scm_vector_copy (items), less);
   else
-    SCM_WRONG_TYPE_ARG (1, items);
+    return scm_stable_sort_x (scm_vector_copy (items), less);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0, 
+SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0,
             (SCM items, SCM less),
 	    "Sort the list @var{items}, using @var{less} for comparing the\n"
 	    "list elements. The sorting is destructive, that means that the\n"
diff --git a/libguile/stime.c b/libguile/stime.c
index 78539d9..c876925 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -506,7 +506,7 @@ SCM_DEFINE (scm_gmtime, "gmtime", 1, 0, 0,
 static void
 bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
 {
-  SCM_ASSERT (scm_is_simple_vector (sbd_time)
+  SCM_ASSERT (scm_is_vector (sbd_time)
 	      && SCM_SIMPLE_VECTOR_LENGTH (sbd_time) == 11,
 	      sbd_time, pos, subr);
 
diff --git a/libguile/trees.c b/libguile/trees.c
index 76bb686..88adf88 100644
--- a/libguile/trees.c
+++ b/libguile/trees.c
@@ -99,7 +99,7 @@ copy_tree (struct t_trace *const hare,
            unsigned int tortoise_delay)
 #define FUNC_NAME s_scm_copy_tree
 {
-  if (!scm_is_pair (hare->obj) && !scm_is_simple_vector (hare->obj))
+  if (!scm_is_pair (hare->obj) && !scm_is_vector (hare->obj))
     {
       return hare->obj;
     }
@@ -128,7 +128,7 @@ copy_tree (struct t_trace *const hare,
           --tortoise_delay;
         }
 
-      if (scm_is_simple_vector (hare->obj))
+      if (scm_is_vector (hare->obj))
         {
           size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj);
           SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED);
diff --git a/libguile/validate.h b/libguile/validate.h
index 0bdc057..3495198 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -360,12 +360,12 @@
 
 #define SCM_VALIDATE_VECTOR(pos, v) \
   do { \
-    SCM_ASSERT (scm_is_simple_vector (v), v, pos, FUNC_NAME); \
+    SCM_ASSERT (scm_is_vector (v), v, pos, FUNC_NAME); \
   } while (0)
 
 #define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \
   do { \
-    SCM_ASSERT ((scm_is_simple_vector (v) \
+    SCM_ASSERT ((scm_is_vector (v) \
                 || (scm_is_true (scm_f64vector_p (v)))), \
                 v, pos, FUNC_NAME); \
   } while (0)
diff --git a/libguile/vectors.c b/libguile/vectors.c
index b386deb..775aa80 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -47,14 +47,7 @@
 int
 scm_is_vector (SCM obj)
 {
-  if (SCM_I_IS_VECTOR (obj))
-    return 1;
-  if  (SCM_I_ARRAYP (obj) && SCM_I_ARRAY_NDIM (obj) == 1)
-    {
-      SCM v = SCM_I_ARRAY_V (obj);
-      return SCM_I_IS_VECTOR (v);
-    }
-  return 0;
+  return SCM_I_IS_VECTOR (obj);
 }
 
 int
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 01ffd1c..6c736b6 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -109,6 +109,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/r6rs-unicode.test		\
 	    tests/rnrs-libraries.test		\
 	    tests/ramap.test			\
+	    tests/random.test			\
 	    tests/rdelim.test			\
 	    tests/reader.test			\
 	    tests/receive.test			\
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 8ad97f4..e0aa5ca 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -1,4 +1,4 @@
-;;;; unif.test --- tests guile's uniform arrays     -*- scheme -*-
+;;;; arrays.test --- tests guile's uniform arrays     -*- scheme -*-
 ;;;;
 ;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;;
diff --git a/test-suite/tests/random.test b/test-suite/tests/random.test
new file mode 100644
index 0000000..ab20b58
--- /dev/null
+++ b/test-suite/tests/random.test
@@ -0,0 +1,55 @@
+;;;; random.test --- tests guile's uniform arrays     -*- scheme -*-
+;;;;
+;;;; Copyright 2013 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
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite test-random)
+  #:use-module ((system base compile) #:select (compile))
+  #:use-module (test-suite lib)
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-4 gnu))
+
+; see strings.test, arrays.test.
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
+;;;
+;;; random:normal-vector!
+;;;
+
+(with-test-prefix "random:normal-vector!"
+
+  ;; FIXME need proper function test.
+
+  (pass-if "non uniform"
+    (let ((a (make-vector 4 0))
+          (b (make-vector 4 0))
+          (c (make-shared-array (make-vector 8 0)
+                                (lambda (i) (list (+ 1 (* 2 i)))) 4)))
+      (begin
+        (random:normal-vector! b (random-state-from-platform))
+        (random:normal-vector! c (random-state-from-platform))
+        (and (not (equal? a b)) (not (equal? a c))))))
+
+  (pass-if "uniform (f64)"
+    (let ((a (make-f64vector 4 0))
+          (b (make-f64vector 4 0))
+          (c (make-shared-array (make-f64vector 8 0)
+                                (lambda (i) (list (+ 1 (* 2 i)))) 4)))
+      (begin
+        (random:normal-vector! b (random-state-from-platform))
+        (random:normal-vector! c (random-state-from-platform))
+        (and (not (equal? a b)) (not (equal? a c)))))))
-- 
1.8.2


[-- Attachment #18: 0017-vector-ref-vector-set-reject-non-vector-args.patch --]
[-- Type: application/octet-stream, Size: 2612 bytes --]

From 148805a550f716cfe1b5b38fdb0a85979ae88b25 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 18:28:19 +0200
Subject: [PATCH 17/22] vector-ref, vector-set! reject non vector? args

* libguile/vectors.c: (scm_c_vector_ref, scm_c_vector_set_x):
  throw type error if v is not vector?.
---
 libguile/vectors.c | 50 +-------------------------------------------------
 1 file changed, 1 insertion(+), 49 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 775aa80..94951b0 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -213,27 +213,6 @@ scm_c_vector_ref (SCM v, size_t k)
 
       return elt;
     }
-  else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
-    {
-      scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
-      SCM vv = SCM_I_ARRAY_V (v);
-      if (SCM_I_IS_VECTOR (vv))
-	{
-	  register SCM elt;
-
-	  if (k >= dim->ubnd - dim->lbnd + 1)
-	    scm_out_of_range (NULL, scm_from_size_t (k));
-	  k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
-	  elt = (SCM_I_VECTOR_ELTS (vv))[k];
-
-	  if (SCM_UNPACK (elt) == 0 && (SCM_I_WVECTP (vv)))
-	    /* ELT was a weak pointer and got nullified by the GC.  */
-	    return SCM_BOOL_F;
-
-	  return elt;
-	}
-      scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
-    }
   else
     SCM_WTA_DISPATCH_2 (g_vector_ref, v, scm_from_size_t (k), 2, NULL);
 }
@@ -275,35 +254,8 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
 	  SCM_I_REGISTER_DISAPPEARING_LINK ((void **) link, SCM2PTR (obj));
 	}
     }
-  else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
-    {
-      scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
-      SCM vv = SCM_I_ARRAY_V (v);
-      if (SCM_I_IS_VECTOR (vv))
-	{
-	  if (k >= dim->ubnd - dim->lbnd + 1)
-	    scm_out_of_range (NULL, scm_from_size_t (k));
-	  k = SCM_I_ARRAY_BASE (v) + k*dim->inc;
-	  (SCM_I_VECTOR_WELTS (vv))[k] = obj;
-
-	  if (SCM_I_WVECTP (vv))
-	    {
-	      /* Make it a weak pointer.  */
-	      SCM *link = & SCM_I_VECTOR_WELTS (vv)[k];
-	      SCM_I_REGISTER_DISAPPEARING_LINK ((void **) link, SCM2PTR (obj));
-	    }
-	}
-      else
-	scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
-    }
   else
-    {
-      if (SCM_UNPACK (g_vector_set_x))
-	scm_apply_generic (g_vector_set_x,
-			   scm_list_3 (v, scm_from_size_t (k), obj));
-      else
-	scm_wrong_type_arg_msg (NULL, 0, v, "vector");
-    }
+    scm_wrong_type_arg_msg (NULL, 0, v, "vector");
 }
 
 SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
-- 
1.8.2


[-- Attachment #19: 0018-vector-length-rejects-non-vector-arg.patch --]
[-- Type: application/octet-stream, Size: 2069 bytes --]

From 934d9f2c167eaed58343cc8707abe6d0538271aa Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 19:32:23 +0200
Subject: [PATCH 18/22] vector-length rejects non vector? arg

* libguile/vectors.c
  - scm_c_vector_length:  error if SCM_I_IS_VECTOR (v) fails.
  - scm_vector_length: Documentation for vector-length.
---
 libguile/vectors.c | 32 +++++++++++++++-----------------
 1 file changed, 15 insertions(+), 17 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 94951b0..46ee934 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -104,31 +104,29 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_GPROC (s_vector_length, "vector-length", 1, 0, 0, scm_vector_length, g_vector_length);
-/* Returns the number of elements in @var{vector} as an exact integer.  */
-SCM
-scm_vector_length (SCM v)
-{
-  if (SCM_I_IS_VECTOR (v))
-    return scm_from_size_t (SCM_I_VECTOR_LENGTH (v));
-  else if (SCM_I_ARRAYP (v) && SCM_I_ARRAY_NDIM (v) == 1)
-    {
-      scm_t_array_dim *dim = SCM_I_ARRAY_DIMS (v);
-      return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
-    }
-  else
-    SCM_WTA_DISPATCH_1 (g_vector_length, v, 1, NULL);
-}
-
 size_t
 scm_c_vector_length (SCM v)
 {
   if (SCM_I_IS_VECTOR (v))
     return SCM_I_VECTOR_LENGTH (v);
   else
-    return scm_to_size_t (scm_vector_length (v));
+    scm_wrong_type_arg_msg (NULL, 0, v, "vector");
 }
 
+SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0,
+	    (SCM v),
+            "Return the number of elements in vector @var{v} as an exact\n"
+            "integer.\n"
+	    "\n"
+	    "@lisp\n"
+	    "(vector-length #(a b c)) @result{} 3\n"
+	    "@end lisp")
+#define FUNC_NAME s_scm_vector_length
+{
+  return scm_from_size_t (scm_c_vector_length (v));
+}
+#undef FUNC_NAME
+
 SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
 /*
 	    "Return a newly created vector initialized to the elements of"
-- 
1.8.2


[-- Attachment #20: 0019-Online-documentation-for-vector-ref-vector-set.patch --]
[-- Type: application/octet-stream, Size: 5049 bytes --]

From 677b5b5aacd228c3e833bb09fe2524912f26b23c Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 19:38:19 +0200
Subject: [PATCH 19/22] Online documentation for vector-ref, vector-set!

* libguile/vectors.c: (scm_vector_ref, scm_vector_set!): embed the
  comments as documentation.
---
 libguile/vectors.c | 84 ++++++++++++++++++++++++------------------------------
 1 file changed, 38 insertions(+), 46 deletions(-)

diff --git a/libguile/vectors.c b/libguile/vectors.c
index 46ee934..82f79eb 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -136,9 +136,8 @@ SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 0, scm_vector);
 	    "(list->vector '(dididit dah)) @result{}   #(dididit dah)\n"
 	    "@end lisp")
 */
-SCM_DEFINE (scm_vector, "vector", 0, 0, 1, 
+SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
 	    (SCM l),
-	    "@deffnx {Scheme Procedure} list->vector l\n"
 	    "Return a newly allocated vector composed of the\n"
 	    "given arguments.  Analogous to @code{list}.\n"
 	    "\n"
@@ -170,30 +169,6 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
 }
 #undef FUNC_NAME
 
-SCM_GPROC (s_vector_ref, "vector-ref", 2, 0, 0, scm_vector_ref, g_vector_ref);
-
-/*
-           "@var{k} must be a valid index of @var{vector}.\n"
-	   "@samp{Vector-ref} returns the contents of element @var{k} of\n"
-	   "@var{vector}.\n\n"
-	   "@lisp\n"
-	   "(vector-ref '#(1 1 2 3 5 8 13 21) 5) @result{} 8\n"
-	   "(vector-ref '#(1 1 2 3 5 8 13 21)\n"
-	   "    (let ((i (round (* 2 (acos -1)))))\n"
-	   "      (if (inexact? i)\n"
-	   "        (inexact->exact i)\n"
-	   "           i))) @result{} 13\n"
-	   "@end lisp"
-*/
-
-SCM
-scm_vector_ref (SCM v, SCM k)
-#define FUNC_NAME s_vector_ref
-{
-  return scm_c_vector_ref (v, scm_to_size_t (k));
-}
-#undef FUNC_NAME
-
 SCM
 scm_c_vector_ref (SCM v, size_t k)
 {
@@ -212,38 +187,36 @@ scm_c_vector_ref (SCM v, size_t k)
       return elt;
     }
   else
-    SCM_WTA_DISPATCH_2 (g_vector_ref, v, scm_from_size_t (k), 2, NULL);
+    scm_wrong_type_arg_msg (NULL, 0, v, "vector");
 }
 
-SCM_GPROC (s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x, g_vector_set_x);
-
-/* "@var{k} must be a valid index of @var{vector}.\n"
-   "@code{Vector-set!} stores @var{obj} in element @var{k} of @var{vector}.\n"
-   "The value returned by @samp{vector-set!} is unspecified.\n"
-   "@lisp\n"
-   "(let ((vec (vector 0 '(2 2 2 2) "Anna")))\n"
-   "  (vector-set! vec 1 '("Sue" "Sue"))\n"
-   "  vec) @result{}  #(0 ("Sue" "Sue") "Anna")\n"
-   "(vector-set! '#(0 1 2) 1 "doe") @result{} @emph{error} ; constant vector\n"
-   "@end lisp"
-*/
-
-SCM
-scm_vector_set_x (SCM v, SCM k, SCM obj)
-#define FUNC_NAME s_vector_set_x
+SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0,
+	    (SCM v, SCM k),
+            "@var{k} must be a valid index of @var{vector}.\n"
+            "@samp{vector-ref} returns the contents of element @var{k} of\n"
+            "@var{vector}.\n\n"
+            "@lisp\n"
+            "(vector-ref '#(1 1 2 3 5 8 13 21) 5) @result{} 8\n"
+            "(vector-ref '#(1 1 2 3 5 8 13 21)\n"
+            "    (let ((i (round (* 2 (acos -1)))))\n"
+            "      (if (inexact? i)\n"
+            "        (inexact->exact i)\n"
+            "           i))) @result{} 13\n"
+            "@end lisp")
+#define FUNC_NAME s_scm_vector_ref
 {
-  scm_c_vector_set_x (v, scm_to_size_t (k), obj);
-  return SCM_UNSPECIFIED;
+  return scm_c_vector_ref (v, scm_to_size_t (k));
 }
 #undef FUNC_NAME
 
+
 void
 scm_c_vector_set_x (SCM v, size_t k, SCM obj)
 {
   if (SCM_I_IS_VECTOR (v))
     {
       if (k >= SCM_I_VECTOR_LENGTH (v))
-	scm_out_of_range (NULL, scm_from_size_t (k)); 
+	scm_out_of_range (NULL, scm_from_size_t (k));
       (SCM_I_VECTOR_WELTS(v))[k] = obj;
       if (SCM_I_WVECTP (v))
 	{
@@ -256,6 +229,25 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
     scm_wrong_type_arg_msg (NULL, 0, v, "vector");
 }
 
+SCM_DEFINE (scm_vector_set_x, "vector-set!", 3, 0, 0,
+            (SCM v, SCM k, SCM obj),
+            "@var{k} must be a valid index of @var{vector}.\n"
+            "@code{Vector-set!} stores @var{obj} in element @var{k} of @var{vector}.\n"
+            "The value returned by @samp{vector-set!} is unspecified.\n"
+            "@lisp\n"
+            "(let ((vec (vector 0 '(2 2 2 2) \"Anna\")))\n"
+            "  (vector-set! vec 1 '(\"Sue\" \"Sue\"))\n"
+            "  vec) @result{}  #(0 (\"Sue\" \"Sue\") \"Anna\")\n"
+            "(vector-set! '#(0 1 2) 1 \"doe\") @result{} @emph{error} ; constant vector\n"
+            "@end lisp")
+#define FUNC_NAME s_scm_vector_set_x
+{
+  scm_c_vector_set_x (v, scm_to_size_t (k), obj);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
 SCM_DEFINE (scm_make_vector, "make-vector", 1, 1, 0,
             (SCM k, SCM fill),
 	    "Return a newly allocated vector of @var{k} elements.  If a\n"
-- 
1.8.2


[-- Attachment #21: 0020-Fix-rank-1-indirection-in-array-map.c.patch --]
[-- Type: application/octet-stream, Size: 1202 bytes --]

From 3c51bae1bb7590120c0ba7ae660f2fdd85f82dd4 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Thu, 11 Apr 2013 22:49:22 +0200
Subject: [PATCH 20/22] Fix rank-1 indirection in array-map.c

* array-map.c: (AREF, ASET): fix buggy indirection carried over
  from old generalized_vector-ref/set!.
---
 libguile/array-map.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 426103c..1bf309c 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -54,7 +54,7 @@ AREF (SCM v, size_t pos)
   scm_t_array_handle h;
   SCM ret;
   scm_array_get_handle (v, &h);
-  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  pos = h.base + (pos - h.dims[0].lbnd) * h.dims[0].inc;
   ret = h.impl->vref (&h, pos);
   scm_array_handle_release (&h);
   return ret;
@@ -65,7 +65,7 @@ ASET (SCM v, size_t pos, SCM val)
 {
   scm_t_array_handle h;
   scm_array_get_handle (v, &h);
-  pos = h.base + h.dims[0].lbnd + pos * h.dims[0].inc;
+  pos = h.base + (pos - h.dims[0].lbnd) * h.dims[0].inc;
   h.impl->vset (&h, pos, val);
   scm_array_handle_release (&h);
 }
-- 
1.8.2


[-- Attachment #22: 0021-Match-uniform_vector_elements-with-vector_elements.patch --]
[-- Type: application/octet-stream, Size: 8702 bytes --]

From 33aa874f41fc03f2ad9460948c1439b84924fe1e Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Fri, 12 Apr 2013 15:04:52 +0200
Subject: [PATCH 21/22] Match uniform_vector_elements with vector_elements

* libguile/vectors.c
  - (scm_vector_writable_elements): allow any non-uniform rank 1 array,
    after the doc. Match the implementation with scm_uniform_vector_elements.
  - (scm_vector_elements): after the above.
* libguile/uniform.c
  - (scm_uniform_vector_writable_elements): ditto for uniform rank 1 arrays.
* libguile/sort.c
  - revert the changes in 7a6fd9, except for the argument type test; allow
    what scm_vector_(writable_)elements allows.
---
 libguile/sort.c    | 57 +++++++++++++++++++-----------------------------------
 libguile/uniform.c | 24 +++++++++++------------
 libguile/vectors.c | 40 ++++++++++++++++----------------------
 3 files changed, 49 insertions(+), 72 deletions(-)

diff --git a/libguile/sort.c b/libguile/sort.c
index 1b47afc..0dd8c8c 100644
--- a/libguile/sort.c
+++ b/libguile/sort.c
@@ -77,25 +77,18 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0,
 #define FUNC_NAME s_scm_restricted_vector_sort_x
 {
   size_t vlen, spos, len;
+  ssize_t vinc;
   scm_t_array_handle handle;
-  scm_t_array_dim *dim;
-
   SCM *velts;
 
-  if (!scm_is_array (vec) || 1 != scm_c_array_rank (vec))
-      SCM_WRONG_TYPE_ARG (1, vec);
-
-  scm_array_get_handle (vec, &handle);
-  velts = scm_array_handle_writable_elements (&handle);
-  dim = scm_array_handle_dims (&handle);
-  vlen = dim->ubnd - dim->lbnd + 1;
+  velts = scm_vector_writable_elements (vec, &handle, &vlen, &vinc);
   spos = scm_to_unsigned_integer (startpos, 0, vlen);
   len = scm_to_unsigned_integer (endpos, spos, vlen) - spos;
 
-  if (dim->inc == 1)
-    quicksort1 (velts + spos, len, less);
+  if (vinc == 1)
+    quicksort1 (velts + spos*vinc, len, less);
   else
-    quicksort (velts + spos*dim->inc, len, dim->inc, less);
+    quicksort (velts + spos*vinc, len, vinc, less);
 
   scm_array_handle_release (&handle);
 
@@ -151,25 +144,19 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0,
       size_t i, len;
       ssize_t inc;
       const SCM *elts;
-      SCM result = SCM_BOOL_T;
 
       elts = scm_vector_elements (items, &handle, &len, &inc);
-
       for (i = 1; i < len; i++, elts += inc)
 	{
 	  if (scm_is_true (scm_call_2 (less, elts[inc], elts[0])))
 	    {
-	      result = SCM_BOOL_F;
-	      break;
+              scm_array_handle_release (&handle);
+	      return SCM_BOOL_F;
 	    }
 	}
-
       scm_array_handle_release (&handle);
-
-      return result;
+      return SCM_BOOL_T;
     }
-
-  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -496,40 +483,36 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0,
       SCM_VALIDATE_LIST_COPYLEN (1, items, len);
       return scm_merge_list_step (&items, less, len);
     }
-  else if (scm_is_array (items) && 1 == scm_c_array_rank (items))
+  else
     {
-      scm_t_array_handle temp_handle, items_handle;
-      scm_t_array_dim *dim;
-      SCM temp, *temp_elts, *items_elts;
+      scm_t_array_handle temp_handle, vec_handle;
+      SCM temp, *temp_elts, *vec_elts;
       size_t len;
+      ssize_t inc;
 
-      scm_array_get_handle (items, &items_handle);
-      items_elts = scm_array_handle_writable_elements (&items_handle);
-      dim = scm_array_handle_dims (&items_handle);
-      len = dim->ubnd - dim->lbnd + 1;
+      vec_elts = scm_vector_writable_elements (items, &vec_handle,
+					       &len, &inc);
       if (len == 0) {
-        scm_array_handle_release (&items_handle);
+        scm_array_handle_release (&vec_handle);
         return items;
       }
 
       temp = scm_c_make_vector (len, SCM_UNDEFINED);
-      scm_array_get_handle (temp, &temp_handle);
-      temp_elts = scm_array_handle_writable_elements (&temp_handle);
+      temp_elts = scm_vector_writable_elements (temp, &temp_handle,
+						NULL, NULL);
 
-      scm_merge_vector_step (items_elts, temp_elts, less, 0, len-1, dim->inc);
+      scm_merge_vector_step (vec_elts, temp_elts, less, 0, len-1, inc);
 
       scm_array_handle_release (&temp_handle);
-      scm_array_handle_release (&items_handle);
+      scm_array_handle_release (&vec_handle);
 
       return items;
     }
-  else
-    SCM_WRONG_TYPE_ARG (1, items);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, 
+SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0,
             (SCM items, SCM less),
 	    "Sort the sequence @var{items}, which may be a list or a\n"
 	    "vector. @var{less} is used for comparing the sequence elements.\n"
diff --git a/libguile/uniform.c b/libguile/uniform.c
index dc6c024..2e684d6 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -215,22 +215,14 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-const void *
-scm_uniform_vector_elements (SCM uvec, 
-			     scm_t_array_handle *h,
-			     size_t *lenp, ssize_t *incp)
-{
-  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
-}
-
 void *
 scm_uniform_vector_writable_elements (SCM uvec,
 				      scm_t_array_handle *h,
 				      size_t *lenp, ssize_t *incp)
 {
-  void *ret;
-  if (!scm_is_uniform_vector (uvec))
-    scm_wrong_type_arg_msg (NULL, 0, uvec, "uniform vector");
+  void * ret;
+  if (!scm_is_array (uvec) || 1 != scm_c_array_rank (uvec))
+    scm_wrong_type_arg_msg (NULL, 0, uvec, "rank 1 uniform array");
   scm_array_get_handle (uvec, h);
   /* FIXME nonlocal exit */
   ret = scm_array_handle_uniform_writable_elements (h);
@@ -243,7 +235,15 @@ scm_uniform_vector_writable_elements (SCM uvec,
   return ret;
 }
 
-SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, 
+const void *
+scm_uniform_vector_elements (SCM uvec,
+			     scm_t_array_handle *h,
+			     size_t *lenp, ssize_t *incp)
+{
+  return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
+}
+
+SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
 	    (SCM v),
 	    "Return the number of elements in the uniform vector @var{v}.")
 #define FUNC_NAME s_scm_uniform_vector_length
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 82f79eb..94399b0 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -56,45 +56,39 @@ scm_is_simple_vector (SCM obj)
   return SCM_I_IS_VECTOR (obj);
 }
 
-const SCM *
-scm_vector_elements (SCM vec, scm_t_array_handle *h,
-		     size_t *lenp, ssize_t *incp)
-{
-  if (SCM_I_WVECTP (vec))
-    /* FIXME: We should check each (weak) element of the vector for NULL and
-       convert it to SCM_BOOL_F.  */
-    abort ();
-
-  scm_generalized_vector_get_handle (vec, h);
-  if (lenp)
-    {
-      scm_t_array_dim *dim = scm_array_handle_dims (h);
-      *lenp = dim->ubnd - dim->lbnd + 1;
-      *incp = dim->inc;
-    }
-  return scm_array_handle_elements (h);
-}
-
 SCM *
 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
 			      size_t *lenp, ssize_t *incp)
 {
+  SCM * ret;
+
   if (SCM_I_WVECTP (vec))
     /* FIXME: We should check each (weak) element of the vector for NULL and
        convert it to SCM_BOOL_F.  */
     abort ();
 
-  scm_generalized_vector_get_handle (vec, h);
+  if (!scm_is_array (vec) || 1 != scm_c_array_rank (vec))
+    scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 array");
+  scm_array_get_handle (vec, h);
+  /* FIXME nonlocal exit */
+  ret = scm_array_handle_writable_elements (h);
   if (lenp)
     {
       scm_t_array_dim *dim = scm_array_handle_dims (h);
       *lenp = dim->ubnd - dim->lbnd + 1;
       *incp = dim->inc;
     }
-  return scm_array_handle_writable_elements (h);
+  return ret;
+}
+
+const SCM *
+scm_vector_elements (SCM vec, scm_t_array_handle *h,
+		     size_t *lenp, ssize_t *incp)
+{
+  return scm_vector_writable_elements (vec, h, lenp, incp);
 }
 
-SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, 
+SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
 	    (SCM obj),
 	    "Return @code{#t} if @var{obj} is a vector, otherwise return\n"
 	    "@code{#f}.")
@@ -156,7 +150,7 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
   res = scm_c_make_vector (len, SCM_UNSPECIFIED);
   data = scm_vector_writable_elements (res, &handle, NULL, NULL);
   i = 0;
-  while (scm_is_pair (l) && i < len) 
+  while (scm_is_pair (l) && i < len)
     {
       data[i] = SCM_CAR (l);
       l = SCM_CDR (l);
-- 
1.8.2


[-- Attachment #23: 0022-Use-underlying-vector-implementation-directly-in-arr.patch --]
[-- Type: application/octet-stream, Size: 6782 bytes --]

From 1aa7e85068e02fa4c99ffac13deefab125d88c56 Mon Sep 17 00:00:00 2001
From: Daniel Llorens <daniel.llorens@bluewin.ch>
Date: Fri, 12 Apr 2013 17:50:09 +0200
Subject: [PATCH 22/22] Use underlying vector implementation directly in array
 handles

* libguile/array-handle.c
  - scm_array_get_handle: if the object is an array, point impl to
    the underlying vector instead of array impl, then fix the axes. Avoid
    calling scm_i_array_implementation_for_obj twice.
* libguile/arrays.c
  - array_handle_ref, array_handle_set, array_get_handle: remove.
* libguile/bitvectors.c, libguile/bytevectors.c, libguile/strings.c,
  libguile/vectors.c: fix base = 0 in the array handle.
* libguile/vectors.c: (vector_handle_set, vector_handle_ref): do not
  use h->dims.
---
 libguile/array-handle.c | 39 ++++++++++++++++++++++++++-------------
 libguile/arrays.c       | 47 +----------------------------------------------
 libguile/bitvectors.c   |  1 +
 libguile/bytevectors.c  |  1 +
 libguile/strings.c      |  1 +
 libguile/vectors.c      |  5 +++--
 6 files changed, 33 insertions(+), 61 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 08778f3..f298f28 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -61,19 +61,32 @@ scm_i_array_implementation_for_obj (SCM obj)
 void
 scm_array_get_handle (SCM array, scm_t_array_handle *h)
 {
-  scm_t_array_implementation *impl = scm_i_array_implementation_for_obj (array);
-  if (!impl)
-    scm_wrong_type_arg_msg (NULL, 0, array, "array");
-  h->array = array;
-  h->impl = impl;
-  h->base = 0;
-  h->ndims = 0;
-  h->dims = NULL;
-  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
-                                                   something... */
-  h->elements = NULL;
-  h->writable_elements = NULL;
-  h->impl->get_handle (array, h);
+  scm_t_array_implementation *impl;
+  if (SCM_I_ARRAYP (array))
+    {
+      SCM v = SCM_I_ARRAY_V (array);
+      impl = scm_i_array_implementation_for_obj (v);
+      h->impl = impl;
+      h->impl->get_handle (v, h);
+      /* this works because the v's impl NEVER uses dims/ndims/base */
+      h->dims = SCM_I_ARRAY_DIMS (array);
+      h->ndims = SCM_I_ARRAY_NDIM (array);
+      h->base = SCM_I_ARRAY_BASE (array);
+    }
+  else
+    {
+      impl = scm_i_array_implementation_for_obj (array);
+      if (impl)
+        {
+          h->impl = impl;
+          /* see bitvector_get_handle, string_get_handle,
+             bytevector_get_handle, vector_get_handle, only ever called
+             from here */
+          h->impl->get_handle (array, h);
+        }
+      else
+        scm_wrong_type_arg_msg (NULL, 0, array, "array");
+    }
 }
 
 ssize_t
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 191d02d..6397067 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -817,52 +817,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
     return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
 }
 
-static SCM
-array_handle_ref (scm_t_array_handle *hh, size_t pos)
-{
-  scm_t_array_handle h;
-  SCM ret;
-  scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
-  ret = h.impl->vref (&h, pos);
-  scm_array_handle_release (&h);
-  return ret;
-}
-
-static void
-array_handle_set (scm_t_array_handle *hh, size_t pos, SCM val)
-{
-  scm_t_array_handle h;
-  scm_array_get_handle (SCM_I_ARRAY_V (hh->array), &h);
-  h.impl->vset (&h, pos, val);
-  scm_array_handle_release (&h);
-}
-
-/* FIXME: should be handle for vect? maybe not, because of dims */
-static void
-array_get_handle (SCM array, scm_t_array_handle *h)
-{
-  scm_t_array_handle vh;
-  scm_array_get_handle (SCM_I_ARRAY_V (array), &vh);
-  if (vh.dims[0].inc != 1 || vh.dims[0].lbnd != 0 || vh.base != 0)
-    {
-      fprintf(stderr, "INC %ld, %ld", vh.dims[0].inc, vh.dims[0].lbnd);
-      fflush(stderr);
-      abort();
-    }
-  h->element_type = vh.element_type;
-  h->elements = vh.elements;
-  h->writable_elements = vh.writable_elements;
-  scm_array_handle_release (&vh);
-
-  h->dims = SCM_I_ARRAY_DIMS (array);
-  h->ndims = SCM_I_ARRAY_NDIM (array);
-  h->base = SCM_I_ARRAY_BASE (array);
-}
-
-SCM_ARRAY_IMPLEMENTATION (scm_tc7_array,
-                          0x7f,
-                          array_handle_ref, array_handle_set,
-                          array_get_handle)
+SCM_ARRAY_IMPLEMENTATION (scm_tc7_array, 0x7f, NULL, NULL, NULL)
 
 void
 scm_init_arrays ()
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c
index 0158490..c05a327 100644
--- a/libguile/bitvectors.c
+++ b/libguile/bitvectors.c
@@ -868,6 +868,7 @@ bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
 static void
 bitvector_get_handle (SCM bv, scm_t_array_handle *h)
 {
+  h->base = 0;
   h->array = bv;
   h->ndims = 1;
   h->dims = &h->dim0;
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index cf41f2f..fc576e7 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -2214,6 +2214,7 @@ bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
 static void
 bytevector_get_handle (SCM v, scm_t_array_handle *h)
 {
+  h->base = 0;
   h->array = v;
   h->ndims = 1;
   h->dims = &h->dim0;
diff --git a/libguile/strings.c b/libguile/strings.c
index 1b241e5..df60bd3 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -2395,6 +2395,7 @@ string_handle_set (scm_t_array_handle *h, size_t index, SCM val)
 static void
 string_get_handle (SCM v, scm_t_array_handle *h)
 {
+  h->base = 0;
   h->array = v;
   h->ndims = 1;
   h->dims = &h->dim0;
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 94399b0..ef6b02e 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -530,7 +530,7 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
 static SCM
 vector_handle_ref (scm_t_array_handle *h, size_t idx)
 {
-  if (idx > h->dims[0].ubnd)
+  if (idx > h->dim0.ubnd)
     scm_out_of_range ("vector-handle-ref", scm_from_size_t (idx));
   return ((SCM*)h->elements)[idx];
 }
@@ -538,7 +538,7 @@ vector_handle_ref (scm_t_array_handle *h, size_t idx)
 static void
 vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
 {
-  if (idx > h->dims[0].ubnd)
+  if (idx > h->dim0.ubnd)
     scm_out_of_range ("vector-handle-set!", scm_from_size_t (idx));
   ((SCM*)h->writable_elements)[idx] = val;
 }
@@ -546,6 +546,7 @@ vector_handle_set (scm_t_array_handle *h, size_t idx, SCM val)
 static void
 vector_get_handle (SCM v, scm_t_array_handle *h)
 {
+  h->base = 0;
   h->array = v;
   h->ndims = 1;
   h->dims = &h->dim0;
-- 
1.8.2

Re: vectors are something else

[Daniel Llorens]

Date: Fri, 12 Apr 2013 17:43:14 -0400
From: Mark H Weaver <mhw@netris.org>

> I've not yet had time to carefully read this thread, but I wanted to say
> that I think we *should* prohibit passing arrays to the vector
> interfaces.  When we have native code generation, then it will be
> possible to make the vector procedures extremely simple machine code
> sequences.  We must avoid adding any complications to this.  Even a
> single additional conditional branch will be painful, in both runtime
> overhead and code size.
> 
> If we were to support a subset of arrays to the vector interface, the
> way it should be done is have the array constructors produce actual
> vector objects when possible, or at least something that can be used by
> the simple vector code sequences without any additional conditional
> branches.
> 
> Does this make sense?

Two things about this.

First, arrays cannot remain opaque types if we want any kind of performance. The compiler should know about the storage and about the array descriptor as independent objects. Then it's possible to inline the index computations, or to eliminate the array descriptor whenever it is not used or when its fields are known at compile time, or to eliminate type checks.

Second, the array operations don't involve any more branching than the vector operations, only an extra indirection that can be amortized over the size of the vector.

That's why I think that there're two options:

[1] have vector- ops only accept vector- types. This removes container type dispatch from the vector- ops but not from the array- ops. The last patch set I've sent to the list goes in this direction. It matches the behavior of other vector-like types such as bytevectors and strings.

[2] force all vector objects into arrays. This removes container type dispatch from both the vector- and the array- ops, but it adds the cost of indirection to the vector- ops. Which is, I think, a good tradeoff, because that cost is smaller, there's some hope that the compiler will remove it in many cases, and we retain the flexibility in the use of vectors that we have now.

This choice affects the interface, if you care about performance. For example in [1], you'd prefer vector- to *reject* strided rank-1 arrays (inc!=1), because those require a descriptor and you want to limit your checks to is-this-scm_tc7_vector. On the other hand, in [2], you want to *accept* offset rank-1 arrays (lbnd!=0) because to reject them you need an explicit check and it's faster to just do the index computation with this lbnd.

What I don't think is a good option is what we have now, where both the vector- and the array- ops have to be able to deal with either type. Aside from the bugs.

Re: vectors are something else

[Daniel Hartwig]

On 15 April 2013 19:29, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>
> [1] have vector- ops only accept vector- types. …
>
> [2] force all vector objects into arrays. …
>
> For example in [1], you'd prefer vector- to *reject* strided rank-1 arrays
> (inc!=1), because those require a descriptor and you want to limit your
> checks to is-this-scm_tc7_vector.

Though such an array is potentially still a vector according to the simple
explanation in the manual.  So this requires introducing a more
complicated discussion of when is an array a vector.  And a lot of the
uses for treating some arrays as vectors will be lost with this, as it
quite restrictive on the layout of the source data.

Given the semantic complications and lesser utility, it may as well be
that no vectors are arrays and reject all.

> On the other hand, in [2],
> you want to *accept* offset rank-1 arrays (lbnd!=0) because to
> reject them you need an explicit check and it's faster to just do
> the index computation with this lbnd.
>

In this case, ‘vector?’ still must answer #f as the offset indexing
makes the object not a vector.  Right?

Most non-vector objects passed to ‘vector-ref’ will throw an error,
except for offset arrays.  Since the result is unspecified aka “it is
an error”, it doesnt have to be correct (ie. include lbnd).  Is it
really much faster to do one or the other:

 if lbnd != 0: error
 index = …

vs:

 index = lbnd + ...

?

Re: vectors are something else

[Daniel Llorens]

On Apr 15, 2013, at 14:28, Daniel Hartwig wrote:

> Though such an array is potentially still a vector according to the simple
> explanation in the manual.  So this requires introducing a more
> complicated discussion of when is an array a vector.

Not really. One just needs to say 'these functions produce vectors. Everything else doesn't'.

> And a lot of the
> uses for treating some arrays as vectors will be lost with this, as it
> quite restrictive on the layout of the source data.

True. One could use arrays though.

> Given the semantic complications and lesser utility, it may as well be
> that no vectors are arrays and reject all.

No disagreement here.

> In this case, ‘vector?’ still must answer #f as the offset indexing
> makes the object not a vector.  Right?

Well... it's really the same argument of 'it is an error'. We can do whatever.

> Most non-vector objects passed to ‘vector-ref’ will throw an error,
> except for offset arrays.  Since the result is unspecified aka “it is
> an error”, it doesnt have to be correct (ie. include lbnd).

Wrong is wrong. Besides, people tend to rely on unspecified behavior. It's the worst we could do. 

> Is it
> really much faster to do one or the other:
> 
> if lbnd != 0: error
> index = …
> 
> vs:
> 
> index = lbnd + ...

The second should actually be just

index = ...

You do this by having the base index point to the element at index 0 and not to the first element. This is a mistake all through the Guile array code.

A branch would certainly be slower. However, if the array implementation was exposed to the compiler, the lbnd!=0 check could be hoisted out of any array loop. So both would end up being identical in that case.

I prefer the second option. But if it comes to you and I having to agree, I'd be ok with the first.

I'm sending a poll to get some more reactions.

Regards

	Daniel

Re: vectors are something else

[Daniel Hartwig]

On 15 April 2013 22:08, Daniel Llorens <daniel.llorens@bluewin.ch> wrote:
>
> On Apr 15, 2013, at 14:28, Daniel Hartwig wrote:
>
>> Is it
>> really much faster to do one or the other:
>>
>> if lbnd != 0: error
>> index = …
>>
>> vs:
>>
>> index = lbnd + ...
>
> The second should actually be just
>
> index = ...
>
> You do this by having the base index point to the element at index 0
> and not to the first element. This is a mistake all through the Guile
> array code.

So lbnd is only for range checking.  Neat.

>
> A branch would certainly be slower. However, if the array implementation
> was exposed to the compiler, the lbnd!=0 check could be hoisted out of
> any array loop. So both would end up being identical in that case.

I see.

Re: vectors are something else

[Mark H Weaver]

Daniel Llorens <daniel.llorens@bluewin.ch> writes:

> Date: Fri, 12 Apr 2013 17:43:14 -0400
> From: Mark H Weaver <mhw@netris.org>
>
>> I've not yet had time to carefully read this thread, but I wanted to say
>> that I think we *should* prohibit passing arrays to the vector
>> interfaces.  When we have native code generation, then it will be
>> possible to make the vector procedures extremely simple machine code
>> sequences.  We must avoid adding any complications to this.  Even a
>> single additional conditional branch will be painful, in both runtime
>> overhead and code size.
>> 
>> If we were to support a subset of arrays to the vector interface, the
>> way it should be done is have the array constructors produce actual
>> vector objects when possible, or at least something that can be used by
>> the simple vector code sequences without any additional conditional
>> branches.
>> 
>> Does this make sense?
>
> Two things about this.
>
> First, arrays cannot remain opaque types if we want any kind of
> performance. The compiler should know about the storage and about the
> array descriptor as independent objects. Then it's possible to inline
> the index computations, or to eliminate the array descriptor whenever
> it is not used or when its fields are known at compile time, or to
> eliminate type checks.

Unfortunately, this is rarely possible in a language like Scheme, where
calls to procedures bound by mutable top-level variables are frequent.
We cannot fix this without making most commonly-used top-level bindings
immutable.  Last I checked, there was strong resistance to this idea.

> Second, the array operations don't involve any more branching than the
> vector operations, only an extra indirection that can be amortized
> over the size of the vector.

The cost can only be amortized in cases where the entire loop over the
vector is done without any calls to procedures bound by mutable
variables.

> That's why I think that there're two options:
>
> [1] have vector- ops only accept vector- types. This removes container
> type dispatch from the vector- ops but not from the array- ops. The
> last patch set I've sent to the list goes in this direction. It
> matches the behavior of other vector-like types such as bytevectors
> and strings.

I very much favor this approach, but unfortunately I don't think we can
do it in 2.0.  It'll have to wait until 2.2.

> [2] force all vector objects into arrays. This removes container type
> dispatch from both the vector- and the array- ops, but it adds the
> cost of indirection to the vector- ops. Which is, I think, a good
> tradeoff, because that cost is smaller, there's some hope that the
> compiler will remove it in many cases, and we retain the flexibility
> in the use of vectors that we have now.

I consider this option completely unacceptable.  Arrays are much more
complex than vectors, and will inevitably be *much* slower in the common
case where the compiler doesn't know much.  Most egregiously,
'make-shared-array' requires that array references apply an arbitrary
affine transformation that's unknown at compile time, which means
multiplications and additions for each index.

Don't get me wrong: I'm all in favor of providing flexible, generic,
extensible procedures.  They have their place.  I think that's why
there's still a justification for keeping 'generalized-vectors' around.
However, efficiency demands that we also have simple, non-generic,
non-extensible procedures as well.  IMO, we should keep the vector,
bitvector, and bytevector procedures as simple as possible.

Does this make sense?  More thoughts?

Thanks for your work on this.

      Mark

Re: vectors are something else

[Daniel Llorens]

On Apr 16, 2013, at 04:00, Mark H Weaver wrote:

>> [1] have vector- ops only accept vector- types. This removes container
>> type dispatch from the vector- ops but not from the array- ops. The
>> last patch set I've sent to the list goes in this direction. It
>> matches the behavior of other vector-like types such as bytevectors
>> and strings.
> 
> I very much favor this approach, but unfortunately I don't think we can
> do it in 2.0.  It'll have to wait until 2.2.

What should we do then about the consistency bugs? like vector? being #f on something that is accepted by vector-ref and so on. Did you have a look at the table I posted?

> I consider this option completely unacceptable.  Arrays are much more
> complex than vectors, and will inevitably be *much* slower in the common
> case where the compiler doesn't know much.

...

> Most egregiously,
> 'make-shared-array' requires that array references apply an arbitrary
> affine transformation that's unknown at compile time, which means
> multiplications and additions for each index.

make-shared-array itself is a very slow function and I'd like to have some alternatives, but it's only called when setting up the shared array. In any case, it's not slow because of any multiplications, but because of how much it conses.

You overestimate (by a lot) the cost of the index computation. One works on arrays by looping over them. In these loops the strides are always constant. No matter the rank of the array, in the inner loop only one index moves. The cost of this stepping is negligible on any scenario that isn't hugely contrived. Things like traversal order and memory order have a much larger impact on performance. 90% of the reason why Guile arrays are dog slow is that they've been programmed with no concern for efficiency. The other 10% is the need to do type dispatch on various kinds of containers and various types of elements. (These numbers are invented.)

> Don't get me wrong: I'm all in favor of providing flexible, generic,
> extensible procedures.  They have their place.  I think that's why
> there's still a justification for keeping 'generalized-vectors' around.

They didn't do anything that the array functions didn't do just as well. Plus they were buggy —they are buggy in stable-2.0. And the names took half the screen.

> However, efficiency demands that we also have simple, non-generic,
> non-extensible procedures as well.  IMO, we should keep the vector,
> bitvector, and bytevector procedures as simple as possible.

Other than the bizarre idea that arrays have to be slow, I think this is a sensible position. After all, arrays have both an array descriptor and a reference to linear storage, so there must be a type for this linear storage. (E.g. in stable-2.0, vector- operations take either arrays, in a buggy way, or the underlying storage type, which is called 'simple vector' and isn't exposed to Scheme.)

What's your take on Daniel Hartwig's position? For example a and b on the table I posted —b is an array, but it prints as #(2 4). How do you justify forbidding vector-ref for something that prints #(2 4) ?

Thanks for you comments,

	Daniel

Re: vectors are something else

[Mark H Weaver]

Daniel Llorens <daniel.llorens@bluewin.ch> writes:

> On Apr 16, 2013, at 04:00, Mark H Weaver wrote:
>
>>> [1] have vector- ops only accept vector- types. This removes container
>>> type dispatch from the vector- ops but not from the array- ops. The
>>> last patch set I've sent to the list goes in this direction. It
>>> matches the behavior of other vector-like types such as bytevectors
>>> and strings.
>> 
>> I very much favor this approach, but unfortunately I don't think we can
>> do it in 2.0.  It'll have to wait until 2.2.
>
> What should we do then about the consistency bugs? like vector? being
> #f on something that is accepted by vector-ref and so on.

I don't know.

> Did you have a look at the table I posted?

Yes, I did, and generally I strongly prefer column [1], but we have to
be very careful what changes we make in a stable release series that
might break compatibility with existing code.  I find this frustrating
as well, which is one reason why I agree with Andy that shifting focus
to 2.2 soon would be a good idea.

>> I consider this option completely unacceptable.  Arrays are much more
>> complex than vectors, and will inevitably be *much* slower in the common
>> case where the compiler doesn't know much.
>
> ...
>
>> Most egregiously,
>> 'make-shared-array' requires that array references apply an arbitrary
>> affine transformation that's unknown at compile time, which means
>> multiplications and additions for each index.
>
> make-shared-array itself is a very slow function and I'd like to have
> some alternatives, but it's only called when setting up the shared
> array. In any case, it's not slow because of any multiplications, but
> because of how much it conses.

I think you misunderstood me.  I'm not talking about the cost of the
'make-shared-array' call itself.  I'm talking about the fact that in
order to support arrays that might have been created using
'make-shared-array', things like 'array-ref' must apply an arbitrary
affine transformation to the indices in order to compute the offset into
the linear storage.

> You overestimate (by a lot) the cost of the index computation. One
> works on arrays by looping over them. In these loops the strides are
> always constant. No matter the rank of the array, in the inner loop
> only one index moves. The cost of this stepping is negligible on any
> scenario that isn't hugely contrived.

Here you're assuming either a single core procedure that loops over the
entire array (e.g. something like 'array-map!'), or a Scheme loop that
the compiler is able to analyze in detail.  Of course, when we have a
fancy native compiler, and if you write your Scheme carefully, you could
certainly arrange to make this optimization possible.

However, there's a lot of Scheme code that uses vectors and is not coded
with such concerns in mind.  In such code, you might have a top-level
procedure that receives an argument and applies 'vector-ref' to it.  In
such cases, if all vectors are actually arrays, the compiler cannot
assume anything about what kind of array is passed in.  Such an array
might have been created by 'make-shared-array', and thus might use an
arbitrary affine transformation.  If 'vector-ref' can be used on such an
array, then this procedure would have to fetch the stride and offset and
do the multiplication each time.  If there's a loop that calls this
top-level procedure, then the compiler can't do anything with this.

In the context of Scheme, with no static type system, with most
procedures accessed via mutable top-level variables, and where programs
are often written in terms of higher-order procedures, analyzing
programs can be very difficult or impossible.  Therefore, it's a bad
idea to have complicated primitives that are slow in the general case,
in the hope that a fancy compiler will be able to analyze entire loops
and make them fast through non-trivial analyses.

>> Don't get me wrong: I'm all in favor of providing flexible, generic,
>> extensible procedures.  They have their place.  I think that's why
>> there's still a justification for keeping 'generalized-vectors' around.
>
> They didn't do anything that the array functions didn't do just as
> well.

Well, generalized vector accessors don't have to cope with multiple
dimensions, nor do they require performing multiplications for most of
the supported vector types.

> Plus they were buggy —they are buggy in stable-2.0.

Bugs are not a good reason to remove an API.

> And the names took half the screen.

This is a weak argument.  You can always make shorter names for them.

Having said all this, I haven't yet thought much about this issue, and
don't (yet) have a strong opinion on whether the generic vector
procedures should be kept.

>> However, efficiency demands that we also have simple, non-generic,
>> non-extensible procedures as well.  IMO, we should keep the vector,
>> bitvector, and bytevector procedures as simple as possible.
>
> Other than the bizarre idea that arrays have to be slow, I think this
> is a sensible position. After all, arrays have both an array
> descriptor and a reference to linear storage, so there must be a type
> for this linear storage. (E.g. in stable-2.0, vector- operations take
> either arrays, in a buggy way, or the underlying storage type, which
> is called 'simple vector' and isn't exposed to Scheme.)
>
> What's your take on Daniel Hartwig's position? For example a and b on
> the table I posted —b is an array, but it prints as #(2 4). How do you
> justify forbidding vector-ref for something that prints #(2 4) ?

I don't think that arrays should ever be printed as #(2 4).

Thanks for the discussion.

     Regards,
       Mark

Re: vectors are something else

[Daniel Llorens]

On Apr 16, 2013, at 08:19, Mark H Weaver wrote:

> Yes, I did, and generally I strongly prefer column [1], but we have to
> be very careful what changes we make in a stable release series that
> might break compatibility with existing code.  I find this frustrating
> as well, which is one reason why I agree with Andy that shifting focus
> to 2.2 soon would be a good idea.

All right.

> I think you misunderstood me.  I'm not talking about the cost of the
> 'make-shared-array' call itself.  I'm talking about the fact that in
> order to support arrays that might have been created using
> 'make-shared-array', things like 'array-ref' must apply an arbitrary
> affine transformation to the indices in order to compute the offset into
> the linear storage.

Sorry if it sounded that way; the specific mention of make-shared-array puzzled me. There are, after all, other functions that imply such a transformation, e.g. transpose-array.

> assume anything about what kind of array is passed in.  Such an array
> might have been created by 'make-shared-array', and thus might use an
> arbitrary affine transformation.  If 'vector-ref' can be used on such an
> array, then this procedure would have to fetch the stride and offset and
> do the multiplication each time.  If there's a loop that calls this
> top-level procedure, then the compiler can't do anything with this.

Since vector-ref takes a single index, 'arbitrary affine transformation' is b+d*i, all three scalars. In a context where the compiler can't do any meaningful optimization, is this going to matter?

At any rate, I accept your point that the indexing cannot be optimized out in general.

> This is a weak argument.  You can always make shorter names for them.

I wasn't serious.

> I don't think that arrays should ever be printed as #(2 4).

The obvious alternative is #1(2 4). As of now, these are 100% equivalent.