[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-153-g7f2c824
|
From: |
Daniel Llorens |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-153-g7f2c824 |
|
Date: |
Thu, 30 Oct 2014 10:42:28 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7f2c824551aa848b359ef6b79c1d5e15d367eb8a
The branch, master has been updated
via 7f2c824551aa848b359ef6b79c1d5e15d367eb8a (commit)
via 0f259045e16ee48ae8c9bcccbe45297ddd90d4a8 (commit)
via 65704b982dcc9758d5e5a5452832a43a1ec453d6 (commit)
via ea342aa6f7fd4a03dc0cc4bde8e6746c1daf083e (commit)
from 856d318a9f543d8a61fcf61caae7d07102586802 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 7f2c824551aa848b359ef6b79c1d5e15d367eb8a
Merge: 856d318 0f25904
Author: Daniel Llorens <address@hidden>
Date: Thu Oct 30 11:42:05 2014 +0100
Merge branch 'lloda-array-support'
-----------------------------------------------------------------------
Summary of changes:
libguile/array-map.c | 20 ++++++------
libguile/arrays.c | 66 ++++++++++++++++++++------------------
libguile/arrays.h | 17 +++------
libguile/deprecated.h | 1 -
module/system/vm/assembler.scm | 31 ++++++++++++++++--
test-suite/test-suite/lib.scm | 2 +
test-suite/tests/arrays.test | 69 +++++++++++++++++++++-------------------
7 files changed, 117 insertions(+), 89 deletions(-)
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 2d68f5f..938f0a7 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,6 +1,6 @@
/* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
* 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -63,11 +63,11 @@ static SCM
make1array (SCM v, ssize_t inc)
{
SCM a = scm_i_make_array (1);
- SCM_I_ARRAY_BASE (a) = 0;
+ SCM_I_ARRAY_SET_BASE (a, 0);
SCM_I_ARRAY_DIMS (a)->lbnd = 0;
SCM_I_ARRAY_DIMS (a)->ubnd = scm_c_array_length (v) - 1;
SCM_I_ARRAY_DIMS (a)->inc = inc;
- SCM_I_ARRAY_V (a) = v;
+ SCM_I_ARRAY_SET_V (a, v);
return a;
}
@@ -195,9 +195,9 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra,
const char *what)
if (k == kroll)
{
SCM y = lra;
- SCM_I_ARRAY_BASE (va0) = cindk (ra0, vi, kroll);
+ SCM_I_ARRAY_SET_BASE (va0, cindk (ra0, vi, kroll));
for (z = lva; !scm_is_null (z); z = SCM_CDR (z), y = SCM_CDR (y))
- SCM_I_ARRAY_BASE (SCM_CAR (z)) = cindk (SCM_CAR (y), vi, kroll);
+ SCM_I_ARRAY_SET_BASE (SCM_CAR (z), cindk (SCM_CAR (y), vi, kroll));
if (! (SCM_UNBNDP (data) ? cproc (va0, lva) : cproc (va0, data,
lva)))
return 0;
--k;
@@ -815,7 +815,7 @@ array_compare (scm_t_array_handle *hx, scm_t_array_handle
*hy,
return 0;
i = hx->dims[dim].ubnd - hx->dims[dim].lbnd + 1;
-
+
incx = hx->dims[dim].inc;
incy = hy->dims[dim].inc;
posx += (i - 1) * incx;
@@ -832,11 +832,11 @@ SCM
scm_array_equal_p (SCM x, SCM y)
{
scm_t_array_handle hx, hy;
- SCM res;
-
+ SCM res;
+
scm_array_get_handle (x, &hx);
scm_array_get_handle (y, &hy);
-
+
res = scm_from_bool (hx.ndims == hy.ndims
&& hx.element_type == hy.element_type);
@@ -860,7 +860,7 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
{
if (SCM_UNBNDP (ra0) || SCM_UNBNDP (ra1))
return SCM_BOOL_T;
-
+
while (!scm_is_null (rest))
{ if (scm_is_false (scm_array_equal_p (ra0, ra1)))
return SCM_BOOL_F;
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 702faac..9e5715c 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,6 +1,6 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
* 2006, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
- *
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -29,6 +29,8 @@
#include <string.h>
#include <assert.h>
+#include "verify.h"
+
#include "libguile/_scm.h"
#include "libguile/__scm.h"
#include "libguile/eq.h"
@@ -92,7 +94,7 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset",
1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
+SCM_DEFINE (scm_shared_array_increments, "shared-array-increments", 1, 0, 0,
(SCM ra),
"For each dimension, return the distance between elements in the
root vector.")
#define FUNC_NAME s_scm_shared_array_increments
@@ -112,15 +114,19 @@ SCM_DEFINE (scm_shared_array_increments,
"shared-array-increments", 1, 0, 0,
}
#undef FUNC_NAME
+/* FIXME: to avoid this assumption, fix the accessors in arrays.h,
+ scm_i_make_array, and the array cases in system/vm/assembler.scm. */
+
+verify (sizeof (scm_t_array_dim) == 3*sizeof (scm_t_bits));
+
+/* Matching SCM_I_ARRAY accessors in arrays.h */
SCM
scm_i_make_array (int ndim)
{
- SCM ra;
- ra = scm_cell (((scm_t_bits) ndim << 17) + scm_tc7_array,
- (scm_t_bits) scm_gc_malloc (sizeof (scm_i_t_array) +
- ndim * sizeof (scm_t_array_dim),
- "array"));
- SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
+ SCM ra = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
+ SCM_I_ARRAY_SET_V (ra, SCM_BOOL_F);
+ SCM_I_ARRAY_SET_BASE (ra, 0);
+ /* dimensions are unset */
return ra;
}
@@ -139,7 +145,7 @@ scm_i_shap2ra (SCM args)
scm_misc_error (NULL, s_bad_spec, SCM_EOL);
ra = scm_i_make_array (ndim);
- SCM_I_ARRAY_BASE (ra) = 0;
+ SCM_I_ARRAY_SET_BASE (ra, 0);
s = SCM_I_ARRAY_DIMS (ra);
for (; !scm_is_null (args); s++, args = SCM_CDR (args))
{
@@ -179,7 +185,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0,
1,
size_t k, rlen = 1;
scm_t_array_dim *s;
SCM ra;
-
+
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_I_ARRAY_DIMS (ra);
@@ -195,8 +201,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0,
1,
if (scm_is_eq (fill, SCM_UNSPECIFIED))
fill = SCM_UNDEFINED;
- SCM_I_ARRAY_V (ra) =
- scm_make_generalized_vector (type, scm_from_size_t (rlen), fill);
+ SCM_I_ARRAY_SET_V (ra, 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 (0 == s->lbnd)
@@ -217,7 +222,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds,
const void *bytes,
scm_t_array_handle h;
void *elts;
size_t sz;
-
+
ra = scm_i_shap2ra (bounds);
SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
s = SCM_I_ARRAY_DIMS (ra);
@@ -229,8 +234,7 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds,
const void *bytes,
SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
}
- SCM_I_ARRAY_V (ra) =
- scm_make_generalized_vector (type, scm_from_size_t (rlen), SCM_UNDEFINED);
+ SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (type, scm_from_size_t
(rlen), SCM_UNDEFINED));
scm_array_get_handle (ra, &h);
@@ -273,7 +277,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts,
size_t len)
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);
@@ -288,7 +292,7 @@ scm_from_contiguous_array (SCM bounds, const SCM *elts,
size_t len)
if (rlen != len)
SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
- SCM_I_ARRAY_V (ra) = scm_c_make_vector (rlen, SCM_UNDEFINED);
+ 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);
@@ -323,7 +327,7 @@ scm_i_ra_set_contp (SCM ra)
SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
return;
}
- inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
+ inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
- SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
}
}
@@ -368,7 +372,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
if (SCM_I_ARRAYP (oldra))
{
- SCM_I_ARRAY_V (ra) = SCM_I_ARRAY_V (oldra);
+ SCM_I_ARRAY_SET_V (ra, SCM_I_ARRAY_V (oldra));
old_base = old_min = old_max = SCM_I_ARRAY_BASE (oldra);
s = scm_array_handle_dims (&old_handle);
k = scm_array_handle_rank (&old_handle);
@@ -382,7 +386,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
}
else
{
- SCM_I_ARRAY_V (ra) = oldra;
+ SCM_I_ARRAY_SET_V (ra, oldra);
old_base = old_min = 0;
old_max = scm_c_array_length (oldra) - 1;
}
@@ -398,9 +402,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
ra = scm_make_generalized_vector (scm_array_type (ra),
SCM_INUM0, SCM_UNDEFINED);
else
- SCM_I_ARRAY_V (ra) =
- scm_make_generalized_vector (scm_array_type (ra),
- SCM_INUM0, SCM_UNDEFINED);
+ SCM_I_ARRAY_SET_V (ra, scm_make_generalized_vector (scm_array_type
(ra),
+ SCM_INUM0,
SCM_UNDEFINED));
scm_array_handle_release (&old_handle);
return ra;
}
@@ -408,7 +411,8 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
imap = scm_apply_0 (mapfunc, scm_reverse (inds));
i = scm_array_handle_pos (&old_handle, imap);
- SCM_I_ARRAY_BASE (ra) = new_min = new_max = i + old_base;
+ new_min = new_max = i + old_base;
+ SCM_I_ARRAY_SET_BASE (ra, new_min);
indptr = inds;
k = SCM_I_ARRAY_NDIM (ra);
while (k--)
@@ -450,7 +454,7 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2,
0, 1,
/* args are RA . DIMS */
-SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
+SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
(SCM ra, SCM args),
"Return an array sharing contents with @var{ra}, but with\n"
"dimensions arranged in a different order. There must be one\n"
@@ -509,8 +513,8 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
}
ndim++;
res = scm_i_make_array (ndim);
- SCM_I_ARRAY_V (res) = SCM_I_ARRAY_V (ra);
- SCM_I_ARRAY_BASE (res) = SCM_I_ARRAY_BASE (ra);
+ SCM_I_ARRAY_SET_V (res, SCM_I_ARRAY_V (ra));
+ SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (ra));
for (k = ndim; k--;)
{
SCM_I_ARRAY_DIMS (res)[k].lbnd = 0;
@@ -534,7 +538,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
r->ubnd = s->ubnd;
if (r->lbnd < s->lbnd)
{
- SCM_I_ARRAY_BASE (res) += (s->lbnd - r->lbnd) * r->inc;
+ SCM_I_ARRAY_SET_BASE (res, SCM_I_ARRAY_BASE (res) + (s->lbnd
- r->lbnd) * r->inc);
r->lbnd = s->lbnd;
}
r->inc += s->inc;
@@ -596,8 +600,8 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
SCM sra = scm_i_make_array (1);
SCM_I_ARRAY_DIMS (sra)->lbnd = 0;
SCM_I_ARRAY_DIMS (sra)->ubnd = len - 1;
- SCM_I_ARRAY_V (sra) = v;
- SCM_I_ARRAY_BASE (sra) = SCM_I_ARRAY_BASE (ra);
+ SCM_I_ARRAY_SET_V (sra, v);
+ SCM_I_ARRAY_SET_BASE (sra, SCM_I_ARRAY_BASE (ra));
SCM_I_ARRAY_DIMS (sra)->inc = (ndim ? SCM_I_ARRAY_DIMS (ra)[ndim -
1].inc : 1);
return sra;
}
@@ -760,7 +764,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state
*pstate)
scm_intprint (h.ndims, 10, port);
if (h.element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
scm_write (scm_array_handle_element_type (&h), port);
-
+
for (i = 0; i < h.ndims; i++)
{
if (h.dims[i].lbnd != 0)
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 6045ab6..5f40597 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -54,23 +54,18 @@ SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim,
SCM lst);
/* internal. */
-typedef struct scm_i_t_array
-{
- SCM v; /* the contents of the array, e.g., a vector or uniform vector. */
- unsigned long base;
-} scm_i_t_array;
-
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
#define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc7_array, a)
#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)>>17))
#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) &
(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))
-#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
-#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v)
-#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
-#define SCM_I_ARRAY_DIMS(a) \
- ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+#define SCM_I_ARRAY_V(a) SCM_CELL_OBJECT_1 (a)
+#define SCM_I_ARRAY_BASE(a) ((size_t) SCM_CELL_WORD_2 (a))
+#define SCM_I_ARRAY_DIMS(a) ((scm_t_array_dim *) SCM_CELL_OBJECT_LOC (a, 3))
+
+#define SCM_I_ARRAY_SET_V(a, v) SCM_SET_CELL_OBJECT_1(a, v)
+#define SCM_I_ARRAY_SET_BASE(a, base) SCM_SET_CELL_WORD_2(a, base)
SCM_INTERNAL SCM scm_i_make_array (int ndim);
SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state
*pstate);
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index ae1fb04..d642b79 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -129,7 +129,6 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard
before,
#define scm_substring_move_right_x
scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x
#define scm_vtable_index_printer
scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer
#define scm_vtable_index_vtable
scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self
-typedef scm_i_t_array scm_i_t_array__GONE__REPLACE_WITH__scm_t_array;
#ifndef BUILDING_LIBGUILE
#define SCM_ASYNC_TICK SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index e944e68..97eade6 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -900,14 +900,15 @@ table, its existing label is used directly."
,(recur (make-uniform-vector-backing-store
(uniform-array->bytevector obj)
width))))))
+ ((array? obj)
+ `((static-patch! ,label 1 ,(recur (shared-array-root obj)))))
(else
(error "don't know how to intern" obj))))
(cond
((immediate? obj) #f)
((vhash-assoc obj (asm-constants asm)) => cdr)
(else
- ;; Note that calling intern may mutate asm-constants and
- ;; asm-constant-inits.
+ ;; Note that calling intern may mutate asm-constants and asm-inits.
(let* ((label (gensym "constant"))
(inits (intern obj label)))
(set-asm-constants! asm (vhash-cons obj label (asm-constants asm)))
@@ -1230,6 +1231,7 @@ should be .data or .rodata), and return the resulting
linker object.
(define tc7-program 69)
(define tc7-bytevector 77)
(define tc7-bitvector 95)
+ (define tc7-array 93)
(let ((word-size (asm-word-size asm))
(endianness (asm-endianness asm)))
@@ -1254,6 +1256,8 @@ should be .data or .rodata), and return the resulting
linker object.
(* 4 word-size))
((uniform-vector-backing-store? x)
(bytevector-length (uniform-vector-backing-store-bytes x)))
+ ((array? x)
+ (* word-size (+ 3 (* 3 (array-rank x)))))
(else
word-size)))
@@ -1310,7 +1314,7 @@ should be .data or .rodata), and return the resulting
linker object.
(write-immediate asm buf pos #f))
((string? obj)
- (let ((tag (logior tc7-ro-string (ash (string-length obj) 8))))
+ (let ((tag (logior tc7-ro-string (ash (string-length obj) 8)))) ;
FIXME: unused?
(case word-size
((4)
(bytevector-u32-set! buf pos tc7-ro-string endianness)
@@ -1385,6 +1389,27 @@ should be .data or .rodata), and return the resulting
linker object.
;; Need to swap units of element-size bytes
(error "FIXME: Implement byte order swap"))))
+ ((array? obj)
+ (let-values
+ ;; array tag + rank + contp flag: see libguile/arrays.h .
+ (((tag) (logior tc7-array (ash (array-rank obj) 17) (ash 1 16)))
+ ((bv-set! bvs-set!)
+ (case word-size
+ ((4) (values bytevector-u32-set! bytevector-s32-set!))
+ ((8) (values bytevector-u64-set! bytevector-s64-set!))
+ (else (error "bad word size")))))
+ (bv-set! buf pos tag endianness)
+ (write-immediate asm buf (+ pos word-size) #f) ; root vector (fixed
later)
+ (bv-set! buf (+ pos (* word-size 2)) 0 endianness) ; base
+ (let lp ((pos (+ pos (* word-size 3)))
+ (bounds (array-shape obj))
+ (incs (shared-array-increments obj)))
+ (when (pair? bounds)
+ (bvs-set! buf pos (first (first bounds)) endianness)
+ (bvs-set! buf (+ pos word-size) (second (first bounds))
endianness)
+ (bvs-set! buf (+ pos (* word-size 2)) (first incs) endianness)
+ (lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs))))))
+
(else
(error "unrecognized object" obj))))
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 749e8cc..27620a7 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -465,6 +465,8 @@
(define-syntax c&e
(syntax-rules (pass-if pass-if-equal pass-if-exception)
"Run the given tests both with the evaluator and the compiler/VM."
+ ((_ (pass-if exp))
+ (c&e (pass-if "[unnamed test]" exp)))
((_ (pass-if test-name exp))
(begin (pass-if (string-append test-name " (eval)")
(primitive-eval 'exp))
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 415f183..66316fe 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -200,7 +200,7 @@
;;; array-equal?
;;;
-(with-test-prefix "array-equal?"
+(with-test-prefix/c&e "array-equal?"
(pass-if "#s16(...)"
(array-equal? #s16(1 2 3) #s16(1 2 3))))
@@ -212,7 +212,7 @@
(define exception:mapping-out-of-range
(cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
-(with-test-prefix "make-shared-array"
+(with-test-prefix/c&e "make-shared-array"
;; this failed in guile 1.8.0
(pass-if "vector unchanged"
@@ -283,9 +283,9 @@
;;; array-contents
;;;
-(with-test-prefix "array-contents"
+(define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
- (define (every-two x) (make-shared-array x (lambda (i) (list (* i 2))) 2))
+(with-test-prefix/c&e "array-contents"
(pass-if "simple vector"
(let* ((a (make-array 0 4)))
@@ -342,30 +342,33 @@
(not (array-contents b))))
;; FIXME maybe this should be allowed.
- #;
- (pass-if "broadcast vector -> empty"
- (let* ((a (make-array 0 4))
- (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
- (if #f #f)))
+ ;; (pass-if "broadcast vector -> empty"
+ ;; (let* ((a (make-array 0 4))
+ ;; (b (make-shared-array a (lambda (i j k) (list k)) 0 1 4)))
+ ;; (if #f #f)))
(pass-if "broadcast 2-rank I"
(let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list 0 j)) 2 3)))
(not (array-contents b))))
- (pass-if "broadcast 2-rank I"
+ (pass-if "broadcast 2-rank II"
(let* ((a #2((1 2 3) (4 5 6)))
(b (make-shared-array a (lambda (i j) (list i 0)) 2 3)))
- (not (array-contents b)))))
+ (not (array-contents b))))
+
+ (pass-if "literal array"
+ (not (not (array-contents #2((1 2 3) (4 5 6)))))))
+
;;;
;;; 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)))))
- (define amap1 (lambda (i) (list (* 2 i))))
- (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
+(with-test-prefix/c&e "shared-array-root"
(pass-if "plain vector"
(let* ((a (make-vector 4 0))
@@ -395,7 +398,7 @@
(define exception:wrong-type-arg
(cons #t "Wrong type"))
-(with-test-prefix "transpose-array"
+(with-test-prefix/c&e "transpose-array"
(pass-if-exception "non array argument" exception:wrong-type-arg
(transpose-array 99))
@@ -436,11 +439,11 @@
;;; array->list
;;;
-(with-test-prefix "array->list"
- (pass-if-equal '(1 2 3) (array->list #s16(1 2 3)))
- (pass-if-equal '(1 2 3) (array->list #(1 2 3)))
- (pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
- (pass-if-equal '() (array->list #()))
+(with-test-prefix/c&e "array->list"
+ (pass-if-equal "uniform vector" '(1 2 3) (array->list #s16(1 2 3)))
+ (pass-if-equal "vector" '(1 2 3) (array->list #(1 2 3)))
+ (pass-if-equal "rank 2 array" '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3
4) (5 6))))
+ (pass-if-equal "empty vector" '() (array->list #()))
(pass-if-equal "http://bugs.gnu.org/12465 - ok"
'(3 4)
@@ -531,7 +534,7 @@
;;; array-in-bounds?
;;;
-(with-test-prefix "array-in-bounds?"
+(with-test-prefix/c&e "array-in-bounds?"
(pass-if (let ((a (make-array #f '(425 425))))
(eq? #f (array-in-bounds? a 0)))))
@@ -542,7 +545,7 @@
(with-test-prefix "array-type"
- (with-test-prefix "on make-foo-vector"
+ (with-test-prefix/c&e "on make-foo-vector"
(pass-if "bool"
(eq? 'b (array-type (make-bitvector 1))))
@@ -728,7 +731,7 @@
;;; syntax
;;;
-(with-test-prefix "syntax"
+(with-test-prefix/c&e "syntax"
(pass-if "rank and lower bounds"
;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
@@ -770,7 +773,7 @@
;;; equal? with vector and one-dimensional array
;;;
-(with-test-prefix "equal?"
+(with-test-prefix/c&e "equal?"
(pass-if "array and non-array"
(not (equal? #2f64((0 1) (2 3)) 100)))
@@ -805,12 +808,12 @@
;;; slices as generalized vectors
;;;
-(let ((array #2u32((0 1) (2 3))))
- (define (array-row a i)
- (make-shared-array a (lambda (j) (list i j))
- (cadr (array-dimensions a))))
- (with-test-prefix "generalized vector slices"
- (pass-if (equal? (array-row array 1)
- #u32(2 3)))
- (pass-if (equal? (array-ref (array-row array 1) 0)
- 2))))
+(define (array-row a i)
+ (make-shared-array a (lambda (j) (list i j))
+ (cadr (array-dimensions a))))
+
+(with-test-prefix/c&e "generalized vector slices"
+ (pass-if (equal? (array-row #2u32((0 1) (2 3)) 1)
+ #u32(2 3)))
+ (pass-if (equal? (array-ref (array-row #2u32((0 1) (2 3)) 1) 0)
+ 2)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-153-g7f2c824,
Daniel Llorens <=