[Guile-commits] 04/11: Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle
lloda pushed a commit to branch lloda-squash0 in repository guile. commit 275ba7d096fb6fb085418c133674bde5ee1db664 Author: Daniel Llorens Date: Wed Feb 11 12:58:01 2015 +0100 Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle * libguile/bytevectors.h (SCM_BYTEVECTOR_TYPE_SIZE, SCM_BYTEVECTOR_TYPED_LENGTH): Moved from libguile/bytevectors.c. * libguile/array-handle.c (scm_array_get_handle): Reuse SCM_BYTEVECTOR_TYPED_LENGTH. --- libguile/array-handle.c |6 ++ libguile/bytevectors.c |5 - libguile/bytevectors.h |5 + 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/libguile/array-handle.c b/libguile/array-handle.c index 2252ecc..3595266 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -185,15 +185,13 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h) break; case scm_tc7_bytevector: { -size_t byte_length, length, element_byte_size; +size_t length; scm_t_array_element_type element_type; scm_t_vector_ref vref; scm_t_vector_set vset; -byte_length = scm_c_bytevector_length (array); element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array); -element_byte_size = scm_i_array_element_type_sizes[element_type] / 8; -length = byte_length / element_byte_size; +length = SCM_BYTEVECTOR_TYPED_LENGTH (array); switch (element_type) { diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index e426ae3..cf247dc 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -192,11 +192,6 @@ #define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent)\ SCM_SET_CELL_OBJECT_3 ((_bv), (_parent)) -#define SCM_BYTEVECTOR_TYPE_SIZE(var) \ - (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8) -#define SCM_BYTEVECTOR_TYPED_LENGTH(var)\ - (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)) - /* The empty bytevector. */ SCM scm_null_bytevector = SCM_UNSPECIFIED; diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h index a5eeaea..af4ac1c 100644 --- a/libguile/bytevectors.h +++ b/libguile/bytevectors.h @@ -129,6 +129,11 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM); #define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv) \ (SCM_BYTEVECTOR_FLAGS (_bv) >> 8UL) +#define SCM_BYTEVECTOR_TYPE_SIZE(var) \ + (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8) +#define SCM_BYTEVECTOR_TYPED_LENGTH(var)\ + (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)) + /* Hint that is passed to `scm_gc_malloc ()' and friends. */ #define SCM_GC_BYTEVECTOR "bytevector"
[Guile-commits] branch lloda-squash0 updated (0961c31 -> 8b49ec3)
lloda pushed a change to branch lloda-squash0 in repository guile. discards 0961c31 New functions (array-for-each-cell, array-for-each-cell-in-order) discards 62eff47 New functions array-from, array-from*, array-amend! discards d9a7257 Special case for array-map! with three arguments discards 612626c Speed up for multi-arg cases of scm_ramap functions discards a910a02 Do not use array handles in scm_vector discards 91a583c Support typed arrays in some sort functions discards 201dfd0 Remove deprecated array functions discards cc71845 Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle discards 8748dc3 Avoid unneeded internal use of array handles discards f3901f9 Remove scm_from_contiguous_array, array 'contiguous' flag discards a3f4add Fix compilation of rank 0 typed array literals adds 67a0b7d Remove .gnuploadrc. adds 06e4091 Texinfo serialization: add braces when needed adds 8622344 Fix slot allocation for prompts new f244ae8 Fix compilation of rank 0 typed array literals new d8ff1be Remove scm_from_contiguous_array, array 'contiguous' flag new d4d92b2 Avoid unneeded internal use of array handles new 275ba7d Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle new b3b1dd2 Remove deprecated array functions new 6799359 Support typed arrays in some sort functions new 89fc555 Do not use array handles in scm_vector new 9cbd415 Speed up for multi-arg cases of scm_ramap functions new a3d953d Special case for array-map! with three arguments new afbb28b New functions array-from, array-from*, array-amend! new 8b49ec3 New functions (array-for-each-cell, array-for-each-cell-in-order) This update added new revisions after undoing existing revisions. That is to say, some revisions that were in the old version of the branch are not in the new version. This situation occurs when a user --force pushes a change and generates a repository containing something like this: * -- * -- B -- O -- O -- O (0961c31) \ N -- N -- N refs/heads/lloda-squash0 (8b49ec3) You should already have received notification emails for all of the O revisions, and so the following emails describe only the N revisions from the common base, B. Any revisions marked "omits" are not gone; other references still refer to them. Any revisions marked "discards" are gone forever. The 11 revisions listed above as "new" are entirely new to this repository and will be described in separate emails. The revisions listed as "adds" were already present in the repository and have only been added to this reference. Summary of changes: .gnuploadrc |1 - module/language/cps/slot-allocation.scm | 51 module/texinfo/serialize.scm| 79 +++ test-suite/tests/compiler.test | 25 ++ test-suite/tests/texinfo.serialize.test |9 +++- 5 files changed, 113 insertions(+), 52 deletions(-) delete mode 100644 .gnuploadrc
[Guile-commits] 11/11: New functions (array-for-each-cell, array-for-each-cell-in-order)
lloda pushed a commit to branch lloda-squash0 in repository guile. commit 8b49ec31081b37f12c3909801353f6bad4dfaffe Author: Daniel Llorens Date: Tue Sep 8 16:57:30 2015 +0200 New functions (array-for-each-cell, array-for-each-cell-in-order) * libguile/array-map.c (scm_i_array_rebase, scm_array_for_each_cell): New functions. Export scm_array_for_each_cell() as (array-for-each-cell). (array-for-each-cell-in-order): Define additional export. * libguile/array-map.h (scm_i_array_rebase, scm_array_for_each_cell): Add prototypes. * doc/ref/api-compound.texi: New section 'Arrays as arrays of arrays'. Move the documentation for (array-from), (array-from*) and (array-amend!) in here. Add documentation for (array-for-each-cell). * test-suite/tests/array-map.test: Renamed from test-suite/tests/ramap.test, fix module name. Add tests for (array-for-each-cell). * test-suite/Makefile.am: Apply rename array-map.test -> ramap.test. * doc/ref/api-compound.texi: Minor documentation fixes. --- doc/ref/api-compound.texi | 169 ++- libguile/array-map.c| 260 ++- libguile/array-map.h|4 + libguile/arrays.c |5 +- test-suite/Makefile.am |2 +- test-suite/tests/{ramap.test => array-map.test} | 35 ++- 6 files changed, 416 insertions(+), 59 deletions(-) diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index 6d1e118..936b495 100644 --- a/doc/ref/api-compound.texi +++ b/doc/ref/api-compound.texi @@ -1203,6 +1203,7 @@ dimensional arrays. * Array Syntax:: * Array Procedures:: * Shared Arrays:: +* Arrays as arrays of arrays:: * Accessing Arrays from C:: @end menu @@ -1682,24 +1683,91 @@ sample points are enough because @var{mapfunc} is linear. Return the element at @code{(idx @dots{})} in @var{array}. @end deffn + +@deffn {Scheme Procedure} shared-array-increments array +@deffnx {C Function} scm_shared_array_increments (array) +For each dimension, return the distance between elements in the root vector. +@end deffn + +@deffn {Scheme Procedure} shared-array-offset array +@deffnx {C Function} scm_shared_array_offset (array) +Return the root vector index of the first element in the array. +@end deffn + +@deffn {Scheme Procedure} shared-array-root array +@deffnx {C Function} scm_shared_array_root (array) +Return the root vector of a shared array. +@end deffn + +@deffn {Scheme Procedure} array-contents array [strict] +@deffnx {C Function} scm_array_contents (array, strict) +If @var{array} may be @dfn{unrolled} into a one dimensional shared array +without changing their order (last subscript changing fastest), then +@code{array-contents} returns that shared array, otherwise it returns +@code{#f}. All arrays made by @code{make-array} and +@code{make-typed-array} may be unrolled, some arrays made by +@code{make-shared-array} may not be. + +If the optional argument @var{strict} is provided, a shared array will +be returned only if its elements are stored internally contiguous in +memory. +@end deffn + +@deffn {Scheme Procedure} transpose-array array dim1 dim2 @dots{} +@deffnx {C Function} scm_transpose_array (array, dimlist) +Return an array sharing contents with @var{array}, but with +dimensions arranged in a different order. There must be one +@var{dim} argument for each dimension of @var{array}. +@var{dim1}, @var{dim2}, @dots{} should be integers between 0 +and the rank of the array to be returned. Each integer in that +range must appear at least once in the argument list. + +The values of @var{dim1}, @var{dim2}, @dots{} correspond to +dimensions in the array to be returned, and their positions in the +argument list to dimensions of @var{array}. Several @var{dim}s +may have the same value, in which case the returned array will +have smaller rank than @var{array}. + +@lisp +(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d)) +(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d) +(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{} +#2((a 4) (b 5) (c 6)) +@end lisp +@end deffn + +@node Arrays as arrays of arrays +@subsubsection Arrays as arrays of arrays + +The functions in this section allow you to treat an array of rank +@math{n} as an array of lower rank @math{n-k} where the elements are +themselves arrays (`cells') of rank @math{k}. This replicates some of +the functionality of `enclosed arrays', a feature of old Guile that was +removed before @w{version 2.0}. However, these functions do not require +a special type and operate on any array. + +When we operate on an array in this way, we speak of the first @math{k} +dimensions of the array as the @math{k}-`frame' of the array, while the +last @math{n-k} dimensions a
[Guile-commits] 10/11: New functions array-from, array-from*, array-amend!
lloda pushed a commit to branch lloda-squash0 in repository guile. commit afbb28b3b3508c791ec1219e54770cd8f4ddec09 Author: Daniel Llorens Date: Wed Feb 11 16:44:21 2015 +0100 New functions array-from, array-from*, array-amend! * libguile/arrays.h (scm_array_from, scm_array_from_s, scm_array_amend_x): New declarations. * libguile/arrays.c (scm_array_from, scm_array_from_s, scm_array_amend_x): New functions, export as array-from, array-from*, array-amend!. * test-suite/tests/arrays.test: Tests for array-from, array-from*, array-amend!. * doc/ref/api-compound.texi: Document array-from, array-from*, array-amend!. --- doc/ref/api-compound.texi| 105 libguile/arrays.c| 158 ++ libguile/arrays.h|6 ++ test-suite/tests/arrays.test | 109 + 4 files changed, 378 insertions(+) diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index 97aaba3..6d1e118 100644 --- a/doc/ref/api-compound.texi +++ b/doc/ref/api-compound.texi @@ -1676,6 +1676,111 @@ base and stride for new array indices in @var{oldarray} data. A few sample points are enough because @var{mapfunc} is linear. @end deffn + +@deffn {Scheme Procedure} array-ref array idx @dots{} +@deffnx {C Function} scm_array_ref (array, idxlist) +Return the element at @code{(idx @dots{})} in @var{array}. +@end deffn + +@deffn {Scheme Procedure} array-from array idx @dots{} +@deffnx {C Function} scm_array_from (array, idxlist) +If the length of @var{idxlist} equals the rank @math{n} of +@var{array}, return the element at @code{(idx @dots{})}, just like +@code{(array-ref array idx @dots{})}. If, however, the length @math{k} +of @var{idxlist} is shorter than @math{n}, then return the shared +@math{(n-k)}-rank prefix cell of @var{array} given by @var{idxlist}. + +For example: + +@example +@lisp +(array-from #2((a b) (c d)) 0) @result{} #(a b) +(array-from #2((a b) (c d)) 1) @result{} #(c d) +(array-from #2((a b) (c d)) 1 1) @result{} d +(array-from #2((a b) (c d))) @result{} #2((a b) (c d)) +@end lisp +@end example + +@code{(apply array-from array indices)} is equivalent to + +@lisp +(let ((len (length indices))) + (if (= (array-rank a) len) +(apply array-ref a indices) +(apply make-shared-array a + (lambda t (append indices t)) + (drop (array-dimensions a) len +@end lisp + +The name `from' comes from the J language. +@end deffn + +@deffn {Scheme Procedure} array-from* array idx @dots{} +@deffnx {C Function} scm_array_from_s (array, idxlist) +Like @code{(array-from array idx @dots{})}, but return a 0-rank shared +array if the length of @var{idxlist} matches the rank of +@var{array}. This can be useful when using @var{ARRAY} as destination +of copies. + +Compare: + +@example +@lisp +(array-from #2((a b) (c d)) 1 1) @result{} d +(array-from* #2((a b) (c d)) 1) @result{} #0(d) +(define a (make-array 'a 2 2)) +(array-fill! (array-from* a 1 1) 'b) +a @result{} #2((a a) (a b)). +(array-fill! (array-from a 1 1) 'b) @result{} error: not an array +@end lisp +@end example + +@code{(apply array-from* array indices)} is equivalent to + +@lisp +(apply make-shared-array a + (lambda t (append indices t)) + (drop (array-dimensions a) (length indices))) +@end lisp +@end deffn + + +@deffn {Scheme Procedure} array-amend! array x idx @dots{} +@deffnx {C Function} scm_array_amend_x (array, x, idxlist) +If the length of @var{idxlist} equals the rank @math{n} of +@var{array}, set the element at @code{(idx @dots{})} of @var{array} to +@var{x}, just like @code{(array-set! array x idx @dots{})}. If, +however, the length @math{k} of @var{idxlist} is shorter than +@math{n}, then copy the @math{(n-k)}-rank array @var{x} +into @math{(n-k)}-rank prefix cell of @var{array} given by +@var{idxlist}. In this case, the last @math{(n-k)} dimensions of +@var{array} and the dimensions of @var{x} must match exactly. + +This function returns the modified @var{array}. + +For example: + +@example +@lisp +(array-amend! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b)) +(array-amend! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y)) +@end lisp +@end example + +@code{(apply array-amend! array x indices)} is equivalent to + +@lisp +(let ((len (length indices))) + (if (= (array-rank array) len) +(apply array-set! array x indices) +(array-copy! x (apply array-from array indices))) + array) +@end lisp + +The name `amend' comes from the J language. +@end deffn + + @deffn {Scheme Procedure} shared-array-increments array @deffnx {C Function} scm_shared_array_increments (array) For each dimension, return the distance between elements in the root vector. diff --git a/libguile/arrays.c b/libguile/arrays.c index fb522e1..273c48b 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -416,6 +416,164 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-arr
[Guile-commits] 09/11: Special case for array-map! with three arguments
lloda pushed a commit to branch lloda-squash0 in repository guile. commit a3d953d208bbf0007c53d56e7c3a9b517ee5eeaf Author: Daniel Llorens Date: Wed Dec 9 13:10:48 2015 +0100 Special case for array-map! with three arguments Benchmark: (define type #t) (define A (make-typed-array 's32 0 1 1000)) (define B (make-typed-array 's32 0 1 1000)) (define C (make-typed-array 's32 0 1 1000)) before: scheme@(guile-user)> ,time (array-map! C + A B) ;; 0.792653s real time, 0.790970s run time. 0.00s spent in GC. after: scheme@(guile-user)> ,time (array-map! C + A B) ;; 0.598513s real time, 0.597146s run time. 0.00s spent in GC. * libguile/array-map.c (ramap): Add special case with 3 arguments. --- libguile/array-map.c | 60 -- 1 file changed, 38 insertions(+), 22 deletions(-) diff --git a/libguile/array-map.c b/libguile/array-map.c index 9caded8..01bebb8 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -322,32 +322,48 @@ ramap (SCM ra0, SCM proc, SCM ras) h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1))); else { - scm_t_array_handle *hs; - size_t restn = scm_ilength (ras); - - SCM args = SCM_EOL; - SCM *p = &args; - SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint); - for (size_t k = 0; k < restn; ++k) + SCM ra2 = SCM_CAR (ras); + size_t i2 = SCM_I_ARRAY_BASE (ra2); + ssize_t inc2 = SCM_I_ARRAY_DIMS (ra2)->inc; + scm_t_array_handle h2; + ra2 = SCM_I_ARRAY_V (ra2); + scm_array_get_handle (ra2, &h2); + ras = SCM_CDR (ras); + if (scm_is_null (ras)) +for (; n--; i0 += inc0, i1 += inc1, i2 += inc2) + h0.vset (h0.vector, i0, scm_call_2 (proc, h1.vref (h1.vector, i1), h2.vref (h2.vector, i2))); + else { - *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL); - sa[k] = SCM_CARLOC (*p); - p = SCM_CDRLOC (*p); -} + scm_t_array_handle *hs; + size_t restn = scm_ilength (ras); + SCM args = SCM_EOL; + SCM *p = &args; + SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint); + size_t k; + ssize_t i; + + for (k = 0; k < restn; ++k) +{ + *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL); + sa[k] = SCM_CARLOC (*p); + p = SCM_CDRLOC (*p); +} - hs = scm_gc_malloc (sizeof(scm_t_array_handle) * restn, vi_gc_hint); - for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras)) -scm_array_get_handle (scm_car (ras), hs+k); + hs = scm_gc_malloc (sizeof(scm_t_array_handle) * restn, vi_gc_hint); + for (k = 0; k < restn; ++k, ras = scm_cdr (ras)) +scm_array_get_handle (scm_car (ras), hs+k); - for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, ++i) -{ - for (size_t k = 0; k < restn; ++k) -*(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc); - h0.vset (h0.vector, i0, scm_apply_1 (proc, h1.vref (h1.vector, i1), args)); -} + for (i = 0; n--; i0 += inc0, i1 += inc1, i2 += inc2, ++i) +{ + for (k = 0; k < restn; ++k) +*(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc); + h0.vset (h0.vector, i0, scm_apply_2 (proc, h1.vref (h1.vector, i1), h2.vref (h2.vector, i2), args)); +} - for (size_t k = 0; k < restn; ++k) -scm_array_handle_release (hs+k); + for (k = 0; k < restn; ++k) +scm_array_handle_release (hs+k); +} + scm_array_handle_release (&h2); } scm_array_handle_release (&h1); }
[Guile-commits] 08/11: Speed up for multi-arg cases of scm_ramap functions
lloda pushed a commit to branch lloda-squash0 in repository guile. commit 9cbd415adbe64505c8c02c5e0b917cbb2faf7745 Author: Daniel Llorens Date: Fri Feb 13 18:42:27 2015 +0100 Speed up for multi-arg cases of scm_ramap functions This patch results in a 20%-40% speedup in the > 1 argument cases of the following microbenchmarks: (define A (make-shared-array #0(1) (const '()) #e1e7)) ; 1, 2, 3 arguments. (define a 0) ,time (array-for-each (lambda (b) (set! a (+ a b))) A) (define a 0) ,time (array-for-each (lambda (b c) (set! a (+ a b c))) A A) (define a 0) ,time (array-for-each (lambda (b c d) (set! a (+ a b c d))) A A A) (define A (make-shared-array (make-array 1) (const '()) #e1e7)) (define B (make-shared-array #0(1) (const '()) #e1e7)) ; 1, 2, 3 arguments. ,time (array-map! A + B) ,time (array-map! A + B B) ,time (array-map! A + B B B) * libguile/array-map.c (scm_ramap): Note on cproc arguments. (rafill): Assume that dst's lbnd is 0. (racp): Assume that src's lbnd is 0. (ramap): Assume that ra0's lbnd is 0. When there're more than two arguments, compute the array handles before the loop. Allocate the arg list once and reuse it in the loop. (rafe): Do as in ramap(), when there's more than one argument. (AREF, ASET): Remove. --- libguile/array-map.c| 136 +++ libguile/array-map.h|2 +- test-suite/tests/ramap.test |4 +- 3 files changed, 77 insertions(+), 65 deletions(-) diff --git a/libguile/array-map.c b/libguile/array-map.c index 587df02..9caded8 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -1,5 +1,5 @@ /* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009, - * 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. + * 2010, 2011, 2012, 2013, 2014, 2015 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 @@ -48,18 +48,6 @@ static const char vi_gc_hint[] = "array-indices"; static SCM -AREF (SCM v, size_t pos) -{ - return scm_c_array_ref_1 (v, pos); -} - -static void -ASET (SCM v, size_t pos, SCM val) -{ - scm_c_array_set_1_x (v, val, pos); -} - -static SCM make1array (SCM v, ssize_t inc) { SCM a = scm_i_make_array (1); @@ -99,6 +87,10 @@ cindk (SCM ra, ssize_t *ve, int kend) #define LBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].lbnd #define UBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].ubnd + +/* scm_ramapc() always calls cproc with rank-1 arrays created by + make1array. cproc (rafe, ramap, rafill, racp) can assume that the + dims[0].lbnd of these arrays is always 0. */ int scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what) { @@ -167,7 +159,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); va1 = make1array (ra1, 1); - if (LBND (ra0, 0) < LBND (va1, 0) || UBND (ra0, 0) > UBND (va1, 0)) + if (LBND (ra0, 0) < 0 /* LBND (va1, 0) */ || UBND (ra0, 0) > UBND (va1, 0)) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); } *plva = scm_cons (va1, SCM_EOL); @@ -224,14 +216,12 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what) static int rafill (SCM dst, SCM fill) { + size_t n = SCM_I_ARRAY_DIMS (dst)->ubnd + 1; + size_t i = SCM_I_ARRAY_BASE (dst); + ssize_t inc = SCM_I_ARRAY_DIMS (dst)->inc; scm_t_array_handle h; - size_t n, i; - ssize_t inc; - scm_array_get_handle (SCM_I_ARRAY_V (dst), &h); - i = SCM_I_ARRAY_BASE (dst); - inc = SCM_I_ARRAY_DIMS (dst)->inc; - n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1); dst = SCM_I_ARRAY_V (dst); + scm_array_get_handle (dst, &h); for (; n-- > 0; i += inc) h.vset (h.vector, i, fill); @@ -255,19 +245,17 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0, static int racp (SCM src, SCM dst) { - scm_t_array_handle h_s, h_d; - size_t n, i_s, i_d; + size_t i_s, i_d, n; ssize_t inc_s, inc_d; - + scm_t_array_handle h_s, h_d; dst = SCM_CAR (dst); i_s = SCM_I_ARRAY_BASE (src); i_d = SCM_I_ARRAY_BASE (dst); + n = (SCM_I_ARRAY_DIMS (src)->ubnd + 1); inc_s = SCM_I_ARRAY_DIMS (src)->inc; inc_d = SCM_I_ARRAY_DIMS (dst)->inc; - n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1); src = SCM_I_ARRAY_V (src); dst = SCM_I_ARRAY_V (dst); - scm_array_get_handle (src, &h_s); scm_array_get_handle (dst, &h_d); @@ -310,44 +298,56 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0, static int ramap (SCM ra0, SCM proc, SCM ras) { + size_t i0 = SCM_I_ARRAY_BASE (ra0); + ssize_t inc0 = SCM_I_ARRAY_DIMS (ra0)->inc; + size_t n = SCM_I_ARRAY_DIMS (ra0)->ubnd + 1; scm_
[Guile-commits] 07/11: Do not use array handles in scm_vector
lloda pushed a commit to branch lloda-squash0 in repository guile. commit 89fc5554022bdf177e761374db2fd6eb76fc33ea Author: Daniel Llorens Date: Wed Feb 25 09:47:40 2015 +0100 Do not use array handles in scm_vector * libguile/vectors.c (scm_vector): Use SCM_I_VECTOR_WELTS on new vector instead of generic scm_vector_elements; cf. scm_vector_copy(). (scm_vector_elements): Forward to scm_vector_writable_elements(). (scm_vector_writable_elements): Remove special error message for weak vector arg. * libguile/generalized-vectors.c (SCM_VALIDATE_VECTOR_WITH_HANDLE): Remove unused macro. * libguile/array-handle.c (scm_array_handle_elements): Forward to scm_array_handle_writable_elements(). --- libguile/array-handle.c|4 +--- libguile/generalized-vectors.c |5 - libguile/vectors.c | 20 ++-- 3 files changed, 3 insertions(+), 26 deletions(-) diff --git a/libguile/array-handle.c b/libguile/array-handle.c index 3595266..89277d9 100644 --- a/libguile/array-handle.c +++ b/libguile/array-handle.c @@ -320,9 +320,7 @@ scm_array_handle_release (scm_t_array_handle *h) const SCM * scm_array_handle_elements (scm_t_array_handle *h) { - if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM) -scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array"); - return ((const SCM*)h->elements) + h->base; + return scm_array_handle_writable_elements (h); } SCM * diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c index 0fe8b89..276b9d8 100644 --- a/libguile/generalized-vectors.c +++ b/libguile/generalized-vectors.c @@ -69,11 +69,6 @@ SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0, } #undef FUNC_NAME - -#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle) \ - scm_generalized_vector_get_handle (val, handle) - - void scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h) { diff --git a/libguile/vectors.c b/libguile/vectors.c index 5dab545..6dcc7eb 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -59,26 +59,13 @@ const SCM * scm_vector_elements (SCM vec, scm_t_array_handle *h, size_t *lenp, ssize_t *incp) { - if (SCM_I_WVECTP (vec)) -scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); - - 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); + return scm_vector_writable_elements (vec, h, lenp, incp); } SCM * scm_vector_writable_elements (SCM vec, scm_t_array_handle *h, size_t *lenp, ssize_t *incp) { - if (SCM_I_WVECTP (vec)) -scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); - scm_generalized_vector_get_handle (vec, h); if (lenp) { @@ -141,12 +128,11 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, SCM res; SCM *data; long i, len; - scm_t_array_handle handle; SCM_VALIDATE_LIST_COPYLEN (1, l, len); res = scm_c_make_vector (len, SCM_UNSPECIFIED); - data = scm_vector_writable_elements (res, &handle, NULL, NULL); + data = SCM_I_VECTOR_WELTS (res); i = 0; while (scm_is_pair (l) && i < len) { @@ -155,8 +141,6 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1, i += 1; } - scm_array_handle_release (&handle); - return res; } #undef FUNC_NAME
[Guile-commits] 06/11: Support typed arrays in some sort functions
lloda pushed a commit to branch lloda-squash0 in repository guile. commit 6799359454745d14eb8fd4000cdf89fc4bf3de08 Author: Daniel Llorens Date: Tue Jul 12 18:43:03 2016 +0200 Support typed arrays in some sort functions * libguile/sort.c (sort!, sort, restricted-vector-sort!, sorted?): Support arrays of rank 1, whatever the type. * libguile/quicksort.i.c: Fix accessors to handle typed arrays. * test-suite/tests/sort.test: Test also with typed arrays. --- libguile/quicksort.i.c | 45 +++ libguile/sort.c| 131 ++-- test-suite/tests/sort.test | 32 ++- 3 files changed, 140 insertions(+), 68 deletions(-) diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c index 4e39f82..cf1742e 100644 --- a/libguile/quicksort.i.c +++ b/libguile/quicksort.i.c @@ -11,7 +11,7 @@ version but doesn't consume extra memory. */ -#define SWAP(a, b) do { const SCM _tmp = a; a = b; b = _tmp; } while (0) +#define SWAP(a, b) do { const SCM _tmp = GET(a); SET(a, GET(b)); SET(b, _tmp); } while (0) /* Order using quicksort. This implementation incorporates four @@ -54,8 +54,7 @@ #defineSTACK_NOT_EMPTY (stack < top) static void -NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM - SCM less) +NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) { /* Stack node declarations used to store unfulfilled partition obligations. */ typedef struct { @@ -65,8 +64,6 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM static const char s_buggy_less[] = "buggy less predicate used when sorting"; -#define ELT(i) base_ptr[(i)*INC] - if (nr_elems == 0) /* Avoid lossage with unsigned arithmetic below. */ return; @@ -93,17 +90,17 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM SCM_TICK; - if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo - SWAP (ELT(mid), ELT(lo)); - if (scm_is_true (scm_call_2 (less, ELT(hi), ELT(mid - SWAP (ELT(mid), ELT(hi)); + if (scm_is_true (scm_call_2 (less, GET(mid), GET(lo +SWAP (mid, lo); + if (scm_is_true (scm_call_2 (less, GET(hi), GET(mid +SWAP (mid, hi); else goto jump_over; - if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo - SWAP (ELT(mid), ELT(lo)); + if (scm_is_true (scm_call_2 (less, GET(mid), GET(lo +SWAP (mid, lo); jump_over:; - pivot = ELT(mid); + pivot = GET(mid); left = lo + 1; right = hi - 1; @@ -112,7 +109,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM that this algorithm runs much faster than others. */ do { - while (scm_is_true (scm_call_2 (less, ELT(left), pivot))) + while (scm_is_true (scm_call_2 (less, GET(left), pivot))) { left += 1; /* The comparison predicate may be buggy */ @@ -120,7 +117,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM scm_misc_error (NULL, s_buggy_less, SCM_EOL); } - while (scm_is_true (scm_call_2 (less, pivot, ELT(right + while (scm_is_true (scm_call_2 (less, pivot, GET(right { right -= 1; /* The comparison predicate may be buggy */ @@ -130,7 +127,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM if (left < right) { - SWAP (ELT(left), ELT(right)); + SWAP (left, right); left += 1; right -= 1; } @@ -192,11 +189,11 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM and the operation speeds up insertion sort's inner loop. */ for (run = tmp + 1; run <= thresh; run += 1) - if (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp + if (scm_is_true (scm_call_2 (less, GET(run), GET(tmp tmp = run; if (tmp != 0) - SWAP (ELT(tmp), ELT(0)); + SWAP (tmp, 0); /* Insertion sort, running from left-hand-side up to right-hand-side. */ @@ -206,7 +203,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM SCM_TICK; tmp = run - 1; - while (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp + while (scm_is_true (scm_call_2 (less, GET(run), GET(tmp { /* The comparison predicate may be buggy */ if (tmp == 0) @@ -218,12 +215,12 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM tmp += 1; if (tmp != run) { -SCM to_insert = ELT(run); +SCM to_insert = GET(run); size_t hi, lo; for (hi = lo = run; --lo >= tmp; hi = lo) - ELT(hi) = ELT(lo); -ELT(hi) = to_insert;
[Guile-commits] 02/11: Remove scm_from_contiguous_array, array 'contiguous' flag
lloda pushed a commit to branch lloda-squash0 in repository guile. commit d8ff1beb59884277a49f6ef97fb89d48761e02a3 Author: Daniel Llorens Date: Mon Feb 9 17:27:33 2015 +0100 Remove scm_from_contiguous_array, array 'contiguous' flag scm_from_contiguous_array() is undocumented, unused within Guile, and can be trivially replaced by make-array + array-copy without requiring contiguity. The related SCM_I_ARRAY_FLAG_CONTIGUOUS (arrays.h) was set by all array-creating functions (make-typed-array, transpose-array, make-shared-array) but it was only used by array-contents, which needed to traverse the dimensions anyway. * libguile/arrays.h (scm_from_contiguous_array): Remove declaration. * libguile/arrays.c (scm_from_contiguous_array): Remove. (scm_make_typed_array, scm_from_contiguous_typed_array): Don't set the contiguous flag. (scm_transpose_array, scm_make_shared_array): Don't call scm_i_ra_set_contp. (scm_array_contents): Inline scm_i_ra_set_contp() here. Adopt uniform type check order. Remove redundant comments. (scm_i_ra_set_contp): Remove. * test-suite/tests/arrays.test: Test array-contents with rank 0 array. --- libguile/arrays.c| 112 +++--- libguile/arrays.h|4 +- test-suite/tests/arrays.test |6 +++ 3 files changed, 36 insertions(+), 86 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 52fe90a..3cb547f 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -188,7 +188,6 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1, SCM ra; ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); k = SCM_I_ARRAY_NDIM (ra); @@ -225,7 +224,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, size_t sz; ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); s = SCM_I_ARRAY_DIMS (ra); k = SCM_I_ARRAY_NDIM (ra); @@ -270,41 +268,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes, } #undef FUNC_NAME -SCM -scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len) -#define FUNC_NAME "scm_from_contiguous_array" -{ - size_t k, rlen = 1; - scm_t_array_dim *s; - SCM ra; - scm_t_array_handle h; - - ra = scm_i_shap2ra (bounds); - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); - s = SCM_I_ARRAY_DIMS (ra); - k = SCM_I_ARRAY_NDIM (ra); - - while (k--) -{ - s[k].inc = rlen; - SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1); - rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc; -} - if (rlen != len) -SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL); - - SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED)); - scm_array_get_handle (ra, &h); - memcpy (h.writable_elements, elts, rlen * sizeof(SCM)); - scm_array_handle_release (&h); - - if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra)) -if (0 == s->lbnd) - return SCM_I_ARRAY_V (ra); - return ra; -} -#undef FUNC_NAME - SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1, (SCM fill, SCM bounds), "Create and return an array.") @@ -314,27 +277,6 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1, } #undef FUNC_NAME -static void -scm_i_ra_set_contp (SCM ra) -{ - size_t k = SCM_I_ARRAY_NDIM (ra); - if (k) -{ - ssize_t inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc; - while (k--) - { - if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc) - { - SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra); - return; - } - inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd - - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1); - } -} - SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra); -} - SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, (SCM oldra, SCM mapfunc, SCM dims), @@ -448,7 +390,6 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1, return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0, SCM_UNDEFINED); } - scm_i_ra_set_contp (ra); return ra; } #undef FUNC_NAME @@ -547,16 +488,12 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1, } if (ndim > 0) SCM_MISC_ERROR ("bad argument list", SCM_EOL); - scm_i_ra_set_contp (res); return res; } } #undef FUNC_NAME -/* attempts to unroll an array into a one-dimensional array. - returns the unrolled array or #f if it can't be done. */ -/* if strict is true, return #f if returned array - wouldn't have contiguous elements. */ + SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0, (SCM ra, SCM strict), "If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n" @@ -566,31 +503,38 @@ SCM_DEFINE (scm_array_conte
[Guile-commits] 05/11: Remove deprecated array functions
lloda pushed a commit to branch lloda-squash0 in repository guile. commit b3b1dd2091122dc4550de671f9ede235bc6e Author: Daniel Llorens Date: Fri Feb 13 16:45:21 2015 +0100 Remove deprecated array functions * libguile/array-map.c (scm_array_fill_int, scm_array_fill_int, scm_ra_eqp, scm_ra_lessp scm_ra_leqp, scm_ra_grp, scm_ra_greqp, scm_ra_sum, scm_ra_difference, scm_ra_product, scm_ra_divide, scm_array_identity): Remove deprecated functions. * libguile/array-map.h: Remove declaration of deprecated functions. * libguile/generalized-vectors.h, libguile/generalized-vectors.c (scm_is_generalized_vector, scm_c_generalized_vector_length, scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x): These functions were deprecated in 2.0.9. Remove. * doc/ref/api-compound.texi: Remove uniform-array-read!, uniform-array-write from the manual. These procedures where removed in fc7bd367ab4b5027a7f80686b1e229c62e43c90b (2011-05-12). --- doc/ref/api-compound.texi | 33 - libguile/array-map.c | 261 libguile/array-map.h | 16 --- libguile/generalized-vectors.c | 31 - libguile/generalized-vectors.h |4 - 5 files changed, 345 deletions(-) diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi index 8277b35..97aaba3 100644 --- a/doc/ref/api-compound.texi +++ b/doc/ref/api-compound.texi @@ -1568,39 +1568,6 @@ $\left(\matrix{% @end example @end deffn -@deffn {Scheme Procedure} uniform-array-read! ra [port_or_fd [start [end]]] -@deffnx {C Function} scm_uniform_array_read_x (ra, port_or_fd, start, end) -Attempt to read all elements of array @var{ra}, in lexicographic order, as -binary objects from @var{port_or_fd}. -If an end of file is encountered, -the objects up to that point are put into @var{ra} -(starting at the beginning) and the remainder of the array is -unchanged. - -The optional arguments @var{start} and @var{end} allow -a specified region of a vector (or linearized array) to be read, -leaving the remainder of the vector unchanged. - -@code{uniform-array-read!} returns the number of objects read. -@var{port_or_fd} may be omitted, in which case it defaults to the value -returned by @code{(current-input-port)}. -@end deffn - -@deffn {Scheme Procedure} uniform-array-write ra [port_or_fd [start [end]]] -@deffnx {C Function} scm_uniform_array_write (ra, port_or_fd, start, end) -Writes all elements of @var{ra} as binary objects to -@var{port_or_fd}. - -The optional arguments @var{start} -and @var{end} allow -a specified region of a vector (or linearized array) to be written. - -The number of objects actually written is returned. -@var{port_or_fd} may be -omitted, in which case it defaults to the value returned by -@code{(current-output-port)}. -@end deffn - @node Shared Arrays @subsubsection Shared Arrays diff --git a/libguile/array-map.c b/libguile/array-map.c index 938f0a7..587df02 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -307,267 +307,6 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0, #undef FUNC_NAME -#if SCM_ENABLE_DEPRECATED == 1 - -/* to be used as cproc in scm_ramapc to fill an array dimension with - "fill". */ -int -scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) -{ - unsigned long i; - unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd + 1; - long inc = SCM_I_ARRAY_DIMS (ra)->inc; - unsigned long base = SCM_I_ARRAY_BASE (ra); - - ra = SCM_I_ARRAY_V (ra); - - for (i = base; n--; i += inc) -ASET (ra, i, fill); - - return 1; -} - -/* Functions callable by ARRAY-MAP! */ - -int -scm_ra_eqp (SCM ra0, SCM ras) -{ - SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); - scm_t_array_handle ra0_handle; - scm_t_array_dim *ra0_dims; - size_t n; - ssize_t inc0; - size_t i0 = 0; - unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc; - ra1 = SCM_I_ARRAY_V (ra1); - ra2 = SCM_I_ARRAY_V (ra2); - - scm_array_get_handle (ra0, &ra0_handle); - ra0_dims = scm_array_handle_dims (&ra0_handle); - n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1; - inc0 = ra0_dims[0].inc; - - { -for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2) - if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0))) - if (!scm_is_eq (AREF (ra1, i1), AREF (ra2, i2))) - scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F); - } - - scm_array_handle_release (&ra0_handle); - return 1; -} - -/* opt 0 means <, nonzero means >= */ - -static int -ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt) -{ - scm_t_array_handle ra0_handle; - scm_t_array_dim *ra0_dims; - size_t n; - ssize_t inc0; - size_t i0 = 0; - unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2); - long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc; - long inc2 = SCM
[Guile-commits] 03/11: Avoid unneeded internal use of array handles
lloda pushed a commit to branch lloda-squash0 in repository guile. commit d4d92b2e2d3c0b5bc115509d7abd53955c0167e7 Author: Daniel Llorens Date: Mon Feb 9 12:11:52 2015 +0100 Avoid unneeded internal use of array handles * libguile/arrays.c (scm_shared_array_root): Adopt uniform check order. (scm_shared_array_offset, scm_shared_array_increments): Use the array fields directly just as scm_shared_array_root does. (scm_c_array_rank): Moved from libguile/generalized-arrays.c. Don't use array handles, but follow the same type check sequence as the other array functions (shared-array-root, etc). (scm_array_rank): Moved from libguile/generalized-arrays.h. * libguile/arrays.h: Move prototypes here. * test-suite/tests/arrays.test: Tests for shared-array-offset, shared-array-increments. --- libguile/arrays.c | 65 +++ libguile/arrays.h |3 ++ libguile/generalized-arrays.c | 21 libguile/generalized-arrays.h |3 -- test-suite/tests/arrays.test | 76 ++--- 5 files changed, 109 insertions(+), 59 deletions(-) diff --git a/libguile/arrays.c b/libguile/arrays.c index 3cb547f..fb522e1 100644 --- a/libguile/arrays.c +++ b/libguile/arrays.c @@ -64,6 +64,27 @@ (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))) +size_t +scm_c_array_rank (SCM array) +{ + if (SCM_I_ARRAYP (array)) +return SCM_I_ARRAY_NDIM (array); + else if (scm_is_array (array)) +return 1; + else +scm_wrong_type_arg_msg ("array-rank", SCM_ARG1, array, "array"); +} + +SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, + (SCM array), + "Return the number of dimensions of the array @var{array.}\n") +#define FUNC_NAME s_scm_array_rank +{ + return scm_from_size_t (scm_c_array_rank (array)); +} +#undef FUNC_NAME + + SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, (SCM ra), "Return the root vector of a shared array.") @@ -71,10 +92,10 @@ SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0, { if (SCM_I_ARRAYP (ra)) return SCM_I_ARRAY_V (ra); - else if (!scm_is_array (ra)) -scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); - else + else if (scm_is_array (ra)) return ra; + else +scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME @@ -84,13 +105,12 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 1, 0, 0, "Return the root vector index of the first element in the array.") #define FUNC_NAME s_scm_shared_array_offset { - scm_t_array_handle handle; - SCM res; - - scm_array_get_handle (ra, &handle); - res = scm_from_size_t (handle.base); - scm_array_handle_release (&handle); - return res; + if (SCM_I_ARRAYP (ra)) +return scm_from_size_t (SCM_I_ARRAY_BASE (ra)); + else if (scm_is_array (ra)) +return scm_from_size_t (0); + else +scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME @@ -100,18 +120,19 @@ SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0, "For each dimension, return the distance between elements in the root vector.") #define FUNC_NAME s_scm_shared_array_increments { - scm_t_array_handle handle; - SCM res = SCM_EOL; - size_t k; - scm_t_array_dim *s; - - scm_array_get_handle (ra, &handle); - k = scm_array_handle_rank (&handle); - s = scm_array_handle_dims (&handle); - while (k--) -res = scm_cons (scm_from_ssize_t (s[k].inc), res); - scm_array_handle_release (&handle); - return res; + if (SCM_I_ARRAYP (ra)) +{ + size_t k = SCM_I_ARRAY_NDIM (ra); + SCM res = SCM_EOL; + scm_t_array_dim *dims = SCM_I_ARRAY_DIMS (ra); + while (k--) +res = scm_cons (scm_from_ssize_t (dims[k].inc), res); + return res; +} + else if (scm_is_array (ra)) +return scm_list_1 (scm_from_ssize_t (1)); + else +scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array"); } #undef FUNC_NAME diff --git a/libguile/arrays.h b/libguile/arrays.h index 4baa51e..d3e409f 100644 --- a/libguile/arrays.h +++ b/libguile/arrays.h @@ -50,6 +50,9 @@ SCM_API SCM scm_array_contents (SCM ra, SCM strict); SCM_API SCM scm_list_to_array (SCM ndim, SCM lst); SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst); +SCM_API size_t scm_c_array_rank (SCM ra); +SCM_API SCM scm_array_rank (SCM ra); + /* internal. */ #define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0) /* currently unused */ diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c index 9a001eb..fdbdb4a 100644 --- a/libguile/generalized-arrays.c +++ b/libguile/generalized-arrays.c @@ -104,27 +104,6 @@ SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0, } #undef FUNC_NAME -size_t -scm_c_array_rank (SCM array) -{ - scm_t_array_handle ha
[Guile-commits] 01/11: Fix compilation of rank 0 typed array literals
lloda pushed a commit to branch lloda-squash0 in repository guile. commit f244ae848727ca4c35891150ea19e881aa7db2f1 Author: Daniel Llorens Date: Thu Feb 12 13:02:24 2015 +0100 Fix compilation of rank 0 typed array literals * module/system/vm/assembler.scm (simple-uniform-vector?): array-length fails for rank 0 arrays; fix the shape condition. * test-suite/tests/arrays.test: Test reading of #0f64(x) in compilation context. --- module/system/vm/assembler.scm |4 +++- test-suite/tests/arrays.test |8 +++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index a2992b4..facec63 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -1000,7 +1000,9 @@ immediate, and @code{#f} otherwise." (define (simple-uniform-vector? obj) (and (array? obj) (symbol? (array-type obj)) - (equal? (array-shape obj) (list (list 0 (1- (array-length obj))) + (match (array-shape obj) + (((0 n)) #t) + (else #f (define (statically-allocatable? x) "Return @code{#t} if a non-immediate constant can be allocated diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test index e76c699..20cb78b 100644 --- a/test-suite/tests/arrays.test +++ b/test-suite/tests/arrays.test @@ -204,7 +204,13 @@ (with-test-prefix/c&e "array-equal?" (pass-if "#s16(...)" -(array-equal? #s16(1 2 3) #s16(1 2 3 +(array-equal? #s16(1 2 3) #s16(1 2 3))) + + (pass-if "#0f64(...)" +(array-equal? #0f64(99) (make-typed-array 'f64 99))) + + (pass-if "#0(...)" +(array-equal? #0(99) (make-array 99 ;;; ;;; make-shared-array
[Guile-commits] Success: Hydra job gnu:guile-master:build_clang.i686-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_clang.i686-linux’ has changed from "Failed with output" to "Success". For details, see https://hydra.nixos.org/build/41990218 Yay! Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_clang.i686-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_clang.i686-linux’ has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/41973359 Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Success: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on x86_64-linux) has changed from "Failed with output" to "Success". For details, see https://hydra.nixos.org/build/41990204 Yay! Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on x86_64-linux) has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/41973356 Go forth and fix it. Regards, The Hydra build daemon.
[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux
Hi, The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on x86_64-linux) has changed from "Success" to "Failed with output". For details, see https://hydra.nixos.org/build/42025158 Go forth and fix it. Regards, The Hydra build daemon.