mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

(scm_make_vtable): New function, providing `make-vtable'.

Browse source
This commit is contained in:
Kevin Ryde 2007-03-07 21:38:40 +00:00
parent c071ffc8d7
commit b73aa1222a
2 changed files with 29 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/struct.c
View file

@ -560,6 +560,28 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
#undef FUNC_NAME #undef FUNC_NAME
static SCM scm_i_vtable_vtable_no_extra_fields;
SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
(SCM fields, SCM printer),
"Create a vtable, for creating structures with the given\n"
"@var{fields}.\n"
"\n"
"The optional @var{printer} argument is a function to be called\n"
"@code{(@var{printer} struct port)} on the structures created.\n"
"It should look at @var{struct} and write to @var{port}.")
#define FUNC_NAME s_scm_make_vtable
{
if (SCM_UNBNDP (printer))
printer = SCM_BOOL_F;
return scm_make_struct (scm_i_vtable_vtable_no_extra_fields, SCM_INUM0,
scm_list_2 (scm_make_struct_layout (fields),
printer));
}
#undef FUNC_NAME
/* Return true if S1 and S2 are equal structures, i.e., if their vtable and /* Return true if S1 and S2 are equal structures, i.e., if their vtable and
contents are the same. Field protections are honored. Thus, it is an contents are the same. Field protections are honored. Thus, it is an
error to test the equality of structures that contain opaque fields. */ error to test the equality of structures that contain opaque fields. */
@ -879,6 +901,11 @@ scm_init_struct ()
= scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31))); = scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31)));
required_vtable_fields = scm_from_locale_string ("prsrpw"); required_vtable_fields = scm_from_locale_string ("prsrpw");
scm_permanent_object (required_vtable_fields); scm_permanent_object (required_vtable_fields);
scm_i_vtable_vtable_no_extra_fields =
scm_permanent_object
(scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL));
scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout)); scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout));
scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable)); scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable));
scm_c_define ("vtable-index-printer", scm_c_define ("vtable-index-printer",

3
libguile/struct.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_STRUCT_H #ifndef SCM_STRUCT_H
#define SCM_STRUCT_H #define SCM_STRUCT_H
/* Copyright (C) 1995,1997,1999,2000,2001, 2006 Free Software Foundation, Inc. /* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * modify it under the terms of the GNU Lesser General Public
@ -93,6 +93,7 @@ SCM_API SCM scm_make_struct_layout (SCM fields);
SCM_API SCM scm_struct_p (SCM x); SCM_API SCM scm_struct_p (SCM x);
SCM_API SCM scm_struct_vtable_p (SCM x); SCM_API SCM scm_struct_vtable_p (SCM x);
SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init); SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
SCM_API SCM scm_make_vtable (SCM fields, SCM printer);
SCM_API SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init); SCM_API SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init);
SCM_API SCM scm_i_struct_equalp (SCM s1, SCM s2); SCM_API SCM scm_i_struct_equalp (SCM s1, SCM s2);
SCM_API SCM scm_struct_ref (SCM handle, SCM pos); SCM_API SCM scm_struct_ref (SCM handle, SCM pos);