mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

generic vector ops to own file

Browse source 
* libguile/Makefile.am:
* libguile/vectors.c:
* libguile/vectors.h:
* libguile/generalized-vectors.c:
* libguile/generalized-vectors.h: Move generic vector ops off into their
  own file too. The implementation is now based on the generic
  array-handle infrastructure.

* libguile.h:
* libguile/array-map.c:
* libguile/bitvectors.c:
* libguile/random.c:
* libguile/srfi-4.c: Update includers.
This commit is contained in:
Andy Wingo 2009-07-17 19:05:32 +02:00
parent 1030b45049
commit f332e95717
12 changed files with 232 additions and 145 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile.h
View file

@ -55,6 +55,7 @@ extern "C" {
#include "libguile/gc.h"
#include "libguile/gdbint.h"
#include "libguile/generalized-arrays.h"
#include "libguile/generalized-vectors.h"
#include "libguile/goops.h"
#include "libguile/gsubr.h"
#include "libguile/guardians.h"

4
libguile/Makefile.am
View file

@ -144,6 +144,7 @@ libguile_la_SOURCES = \
gdbint.c \
gettext.c \
generalized-arrays.c \
generalized-vectors.c \
goops.c \
gsubr.c \
guardians.c \
@ -252,6 +253,7 @@ DOT_X_FILES = \
gc.x \
gettext.x \
generalized-arrays.x \
generalized-vectors.x \
goops.x \
gsubr.x \
guardians.x \
@ -351,6 +353,7 @@ DOT_DOC_FILES = \
gc.doc \
gettext.doc \
generalized-arrays.doc \
generalized-vectos.doc \
goops.doc \
gsubr.doc \
guardians.doc \
@ -494,6 +497,7 @@ modinclude_HEADERS = \
gdbint.h \
gettext.h \
generalized-arrays.h \
generalized-vectors.h \
goops.h \
gsubr.h \
guardians.h \

1
libguile/array-map.c
View file

@ -39,6 +39,7 @@
#include "libguile/srfi-4.h"
#include "libguile/dynwind.h"
#include "libguile/generalized-arrays.h"
#include "libguile/generalized-vectors.h"
#include "libguile/validate.h"
#include "libguile/array-map.h"

1
libguile/arrays.c
View file

@ -48,6 +48,7 @@
#include "libguile/validate.h"
#include "libguile/arrays.h"
#include "libguile/generalized-arrays.h"
#include "libguile/generalized-vectors.h"
#include "libguile/array-map.h"
#include "libguile/print.h"
#include "libguile/read.h"

1
libguile/bitvectors.c
View file

@ -34,6 +34,7 @@
#include "libguile/arrays.h"
#include "libguile/vectors.h"
#include "libguile/srfi-4.h"
#include "libguile/generalized-vectors.h"
/* Bit vectors. Would be nice if they were implemented on top of bytevectors,
* but alack, all we have is this crufty C.

164
libguile/generalized-vectors.c Normal file
View file

@ -0,0 +1,164 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 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
*/
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/_scm.h"
#include "libguile/__scm.h"
#include "libguile/array-handle.h"
#include "libguile/generalized-arrays.h"
#include "libguile/generalized-vectors.h"
int
scm_is_generalized_vector (SCM obj)
{
int ret = 0;
if (scm_is_array (obj))
{
scm_t_array_handle h;
scm_array_get_handle (obj, &h);
ret = scm_array_handle_rank (&h) == 1;
scm_array_handle_release (&h);
}
return ret;
}
SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a vector, string,\n"
"bitvector, or uniform numeric vector.")
#define FUNC_NAME s_scm_generalized_vector_p
{
return scm_from_bool (scm_is_generalized_vector (obj));
}
#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)
{
scm_array_get_handle (vec, h);
if (scm_array_handle_rank (h) != 1)
{
scm_array_handle_release (h);
scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
}
}
size_t
scm_c_generalized_vector_length (SCM v)
{
scm_t_array_handle h;
size_t ret;
scm_generalized_vector_get_handle (v, &h);
ret = h.dims[0].ubnd - h.dims[0].lbnd + 1;
scm_array_handle_release (&h);
return ret;
}
SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
(SCM v),
"Return the length of the generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_length
{
return scm_from_size_t (scm_c_generalized_vector_length (v));
}
#undef FUNC_NAME
SCM
scm_c_generalized_vector_ref (SCM v, size_t idx)
{
scm_t_array_handle h;
SCM ret;
scm_generalized_vector_get_handle (v, &h);
ret = h.impl->vref (&h, idx);
scm_array_handle_release (&h);
return ret;
}
SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
(SCM v, SCM idx),
"Return the element at index @var{idx} of the\n"
"generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_ref
{
return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
}
#undef FUNC_NAME
void
scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
{
scm_t_array_handle h;
scm_generalized_vector_get_handle (v, &h);
h.impl->vset (&h, idx, val);
scm_array_handle_release (&h);
}
SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
(SCM v, SCM idx, SCM val),
"Set the element at index @var{idx} of the\n"
"generalized vector @var{v} to @var{val}.")
#define FUNC_NAME s_scm_generalized_vector_set_x
{
scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
(SCM v),
"Return a new list whose elements are the elements of the\n"
"generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_to_list
{
SCM ret = SCM_EOL;
ssize_t pos, i = 0;
scm_t_array_handle h;
scm_generalized_vector_get_handle (v, &h);
// FIXME CHECKME
for (pos = h.dims[0].ubnd, i = (h.dims[0].ubnd - h.dims[0].lbnd + 1);
i >= 0;
pos += h.dims[0].inc)
ret = scm_cons (h.impl->vref (&h, pos), ret);
scm_array_handle_release (&h);
return ret;
}
#undef FUNC_NAME
void
scm_init_generalized_vectors ()
{
#include "libguile/generalized-vectors.x"
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/

55
libguile/generalized-vectors.h Normal file
View file

@ -0,0 +1,55 @@
/* classes: h_files */
#ifndef SCM_GENERALIZED_VECTORS_H
#define SCM_GENERALIZED_VECTORS_H
/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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
*/
#include "libguile/__scm.h"
#include "libguile/array-handle.h"
/* Generalized vectors */
SCM_API SCM scm_generalized_vector_p (SCM v);
SCM_API SCM scm_generalized_vector_length (SCM v);
SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
SCM_API SCM scm_generalized_vector_to_list (SCM v);
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 void scm_generalized_vector_get_handle (SCM vec,
scm_t_array_handle *h);
SCM_INTERNAL void scm_init_generalized_vectors (void);
#endif /* SCM_GENERALIZED_VECTORS_H */
/*
Local Variables:
c-file-style: "gnu"
End:
*/

2
libguile/init.c
View file

@ -64,6 +64,7 @@
#include "libguile/gc.h"
#include "libguile/gdbint.h"
#include "libguile/generalized-arrays.h"
#include "libguile/generalized-vectors.h"
#include "libguile/goops.h"
#include "libguile/gsubr.h"
#include "libguile/hash.h"
@ -544,6 +545,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_random ();
scm_init_array_handle ();
scm_init_generalized_arrays ();
scm_init_generalized_vectors ();
scm_init_bitvectors ();
scm_init_array_map ();
scm_init_arrays ();

1
libguile/random.c
View file

@ -36,6 +36,7 @@
#include "libguile/arrays.h"
#include "libguile/srfi-4.h"
#include "libguile/vectors.h"
#include "libguile/generalized-vectors.h"
#include "libguile/validate.h"
#include "libguile/random.h"

1
libguile/srfi-4.c
View file

@ -31,6 +31,7 @@
#include "libguile/srfi-4.h"
#include "libguile/bitvectors.h"
#include "libguile/bytevectors.h"
#include "libguile/generalized-vectors.h"
#include "libguile/error.h"
#include "libguile/read.h"
#include "libguile/ports.h"

131
libguile/vectors.c
View file

@ -30,6 +30,7 @@
#include "libguile/validate.h"
#include "libguile/vectors.h"
#include "libguile/generalized-vectors.h"
#include "libguile/arrays.h"
#include "libguile/bitvectors.h"
#include "libguile/bytevectors.h"
@ -526,136 +527,6 @@ SCM_DEFINE (scm_vector_move_right_x, "vector-move-right!", 5, 0, 0,
#undef FUNC_NAME
/* Generalized vectors. */
int
scm_is_generalized_vector (SCM obj)
{
return (scm_is_vector (obj)
|| scm_is_string (obj)
|| scm_is_bitvector (obj)
|| scm_is_uniform_vector (obj)
|| scm_is_bytevector (obj));
}
SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a vector, string,\n"
"bitvector, or uniform numeric vector.")
#define FUNC_NAME s_scm_generalized_vector_p
{
return scm_from_bool (scm_is_generalized_vector (obj));
}
#undef FUNC_NAME
void
scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
{
scm_array_get_handle (vec, h);
if (scm_array_handle_rank (h) != 1)
scm_wrong_type_arg_msg (NULL, 0, vec, "vector");
}
size_t
scm_c_generalized_vector_length (SCM v)
{
if (scm_is_vector (v))
return scm_c_vector_length (v);
else if (scm_is_string (v))
return scm_c_string_length (v);
else if (scm_is_bitvector (v))
return scm_c_bitvector_length (v);
else if (scm_is_uniform_vector (v))
return scm_c_uniform_vector_length (v);
else if (scm_is_bytevector (v))
return scm_c_bytevector_length (v);
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
(SCM v),
"Return the length of the generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_length
{
return scm_from_size_t (scm_c_generalized_vector_length (v));
}
#undef FUNC_NAME
SCM
scm_c_generalized_vector_ref (SCM v, size_t idx)
{
if (scm_is_vector (v))
return scm_c_vector_ref (v, idx);
else if (scm_is_string (v))
return scm_c_string_ref (v, idx);
else if (scm_is_bitvector (v))
return scm_c_bitvector_ref (v, idx);
else if (scm_is_uniform_vector (v))
return scm_c_uniform_vector_ref (v, idx);
else if (scm_is_bytevector (v))
return scm_from_uint8 (scm_c_bytevector_ref (v, idx));
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
(SCM v, SCM idx),
"Return the element at index @var{idx} of the\n"
"generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_ref
{
return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
}
#undef FUNC_NAME
void
scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val)
{
if (scm_is_vector (v))
scm_c_vector_set_x (v, idx, val);
else if (scm_is_string (v))
scm_c_string_set_x (v, idx, val);
else if (scm_is_bitvector (v))
scm_c_bitvector_set_x (v, idx, val);
else if (scm_is_uniform_vector (v))
scm_c_uniform_vector_set_x (v, idx, val);
else if (scm_is_bytevector (v))
scm_i_bytevector_generalized_set_x (v, idx, val);
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
(SCM v, SCM idx, SCM val),
"Set the element at index @var{idx} of the\n"
"generalized vector @var{v} to @var{val}.")
#define FUNC_NAME s_scm_generalized_vector_set_x
{
scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
(SCM v),
"Return a new list whose elements are the elements of the\n"
"generalized vector @var{v}.")
#define FUNC_NAME s_scm_generalized_vector_to_list
{
if (scm_is_vector (v))
return scm_vector_to_list (v);
else if (scm_is_string (v))
return scm_string_to_list (v);
else if (scm_is_bitvector (v))
return scm_bitvector_to_list (v);
else if (scm_is_uniform_vector (v))
return scm_uniform_vector_to_list (v);
else
scm_wrong_type_arg_msg (NULL, 0, v, "generalized vector");
}
#undef FUNC_NAME
static SCM
vector_handle_ref (scm_t_array_handle *h, size_t idx)
{

15
libguile/vectors.h
View file

@ -61,21 +61,6 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
#define SCM_SIMPLE_VECTOR_REF(x,idx) ((SCM_I_VECTOR_ELTS(x))[idx])
#define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
/* Generalized vectors */
SCM_API SCM scm_generalized_vector_p (SCM v);
SCM_API SCM scm_generalized_vector_length (SCM v);
SCM_API SCM scm_generalized_vector_ref (SCM v, SCM idx);
SCM_API SCM scm_generalized_vector_set_x (SCM v, SCM idx, SCM val);
SCM_API SCM scm_generalized_vector_to_list (SCM v);
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 void scm_generalized_vector_get_handle (SCM vec,
scm_t_array_handle *h);
/* Internals */
#define SCM_I_IS_VECTOR(x) (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))