mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-04 19:20:27 +02:00
deprecate scm_struct_table
* libguile/goops.h: * libguile/goops.c (scm_i_define_class_for_vtable): New internal helper, defines a class for a vtable, relying on the name slot being set correctly. (scm_class_of, create_struct_classes): Use the local vtable-to-class map instead of scm_struct_table. * libguile/struct.h (SCM_STRUCT_TABLE_NAME, SCM_SET_STRUCT_TABLE_NAME) (SCM_STRUCT_TABLE_CLASS, SCM_SET_STRUCT_TABLE_CLASS, scm_struct_table) (scm_struct_create_handle): Deprecate these internals of the map between structs and classes. * libguile/deprecated.h: * libguile/deprecated.c (scm_struct_create_handle): Deprecated code over here now.
This commit is contained in:
Andy Wingo
parent
1d9c2e6271
commit
f3c6a02c88
6 changed files with 79 additions and 60 deletions
|
|
@ -2561,10 +2561,24 @@ scm_whash_insert (SCM whash, SCM key, SCM obj)
|
|||
|
||||
|
||||
|
||||
SCM scm_struct_table = SCM_BOOL_F;
|
||||
|
||||
SCM
|
||||
scm_struct_create_handle (SCM obj)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("`scm_struct_create_handle' is deprecated, and has no effect.");
|
||||
|
||||
return scm_cons (obj, scm_cons (SCM_BOOL_F, SCM_BOOL_F));
|
||||
}
|
||||
|
||||
|
||||
|
||||
void
|
||||
scm_i_init_deprecated ()
|
||||
{
|
||||
properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
|
||||
scm_struct_table = scm_make_hash_table (SCM_UNDEFINED);
|
||||
#include "libguile/deprecated.x"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -768,6 +768,19 @@ SCM_DEPRECATED SCM scm_whash_lookup (SCM whash, SCM obj);
|
|||
SCM_DEPRECATED void scm_whash_insert (SCM whash, SCM key, SCM obj);
|
||||
|
||||
|
||||
|
||||
|
||||
/* No need for a table for names, and the struct->class mapping is
|
||||
maintained by GOOPS now. */
|
||||
#define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X)
|
||||
#define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME)
|
||||
#define SCM_STRUCT_TABLE_CLASS(X) SCM_CDR (X)
|
||||
#define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS)
|
||||
|
||||
SCM_DEPRECATED SCM scm_struct_table;
|
||||
SCM_DEPRECATED SCM scm_struct_create_handle (SCM obj);
|
||||
|
||||
|
||||
|
||||
|
||||
void scm_i_init_deprecated (void);
|
||||
|
|
|
|||
|
|
@ -169,6 +169,8 @@ static SCM class_vm_cont;
|
|||
static SCM class_bytevector;
|
||||
static SCM class_uvec;
|
||||
|
||||
static SCM vtable_class_map = SCM_BOOL_F;
|
||||
|
||||
/* Port classes. Allocate 3 times the maximum number of port types so that
|
||||
input ports, output ports, and in/out ports can be stored at different
|
||||
offsets. See `SCM_IN_PCLASS_INDEX' et al. */
|
||||
|
|
@ -189,6 +191,41 @@ static SCM scm_sys_goops_loaded (void);
|
|||
static SCM scm_make_extended_class_from_symbol (SCM type_name_sym,
|
||||
int applicablep);
|
||||
|
||||
|
||||
SCM
|
||||
scm_i_define_class_for_vtable (SCM vtable)
|
||||
{
|
||||
SCM class;
|
||||
|
||||
if (scm_is_false (vtable_class_map))
|
||||
vtable_class_map = scm_make_weak_key_hash_table (SCM_UNDEFINED);
|
||||
|
||||
if (scm_is_false (scm_struct_vtable_p (vtable)))
|
||||
abort ();
|
||||
|
||||
class = scm_hashq_ref (vtable_class_map, vtable, SCM_BOOL_F);
|
||||
|
||||
if (scm_is_false (class))
|
||||
{
|
||||
if (SCM_UNPACK (scm_class_class))
|
||||
{
|
||||
SCM name = SCM_VTABLE_NAME (vtable);
|
||||
if (!scm_is_symbol (name))
|
||||
name = scm_string_to_symbol (scm_nullstr);
|
||||
|
||||
class = scm_make_extended_class_from_symbol
|
||||
(name, SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_APPLICABLE));
|
||||
}
|
||||
else
|
||||
/* `create_struct_classes' will fill this in later. */
|
||||
class = SCM_BOOL_F;
|
||||
|
||||
scm_hashq_set_x (vtable_class_map, vtable, class);
|
||||
}
|
||||
|
||||
return class;
|
||||
}
|
||||
|
||||
/* This function is used for efficient type dispatch. */
|
||||
SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
||||
(SCM x),
|
||||
|
|
@ -288,26 +325,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
|||
return SCM_CLASS_OF (x);
|
||||
}
|
||||
else
|
||||
{
|
||||
/* ordinary struct */
|
||||
SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x));
|
||||
if (scm_is_true (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
|
||||
return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle));
|
||||
else
|
||||
{
|
||||
SCM class, name;
|
||||
|
||||
name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
|
||||
if (!scm_is_symbol (name))
|
||||
name = scm_string_to_symbol (scm_nullstr);
|
||||
|
||||
class =
|
||||
scm_make_extended_class_from_symbol (name,
|
||||
SCM_STRUCT_APPLICABLE_P (x));
|
||||
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
|
||||
return class;
|
||||
}
|
||||
}
|
||||
return scm_i_define_class_for_vtable (SCM_CLASS_OF (x));
|
||||
default:
|
||||
if (scm_is_pair (x))
|
||||
return scm_class_pair;
|
||||
|
|
@ -2628,23 +2646,16 @@ static SCM
|
|||
make_struct_class (void *closure SCM_UNUSED,
|
||||
SCM vtable, SCM data, SCM prev SCM_UNUSED)
|
||||
{
|
||||
SCM sym = SCM_STRUCT_TABLE_NAME (data);
|
||||
if (scm_is_true (sym))
|
||||
{
|
||||
int applicablep = SCM_CLASS_FLAGS (vtable) & SCM_VTABLE_FLAG_APPLICABLE;
|
||||
|
||||
SCM_SET_STRUCT_TABLE_CLASS (data,
|
||||
scm_make_extended_class_from_symbol (sym, applicablep));
|
||||
}
|
||||
|
||||
scm_remember_upto_here_2 (data, vtable);
|
||||
if (scm_is_false (data))
|
||||
scm_i_define_class_for_vtable (vtable);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
static void
|
||||
create_struct_classes (void)
|
||||
{
|
||||
scm_internal_hash_fold (make_struct_class, 0, SCM_BOOL_F, scm_struct_table);
|
||||
scm_internal_hash_fold (make_struct_class, 0, SCM_BOOL_F,
|
||||
vtable_class_map);
|
||||
}
|
||||
|
||||
/**********************************************************************
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
#ifndef SCM_GOOPS_H
|
||||
#define SCM_GOOPS_H
|
||||
|
||||
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2011 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
|
||||
|
|
@ -307,6 +307,8 @@ SCM_API SCM scm_apply_generic (SCM gf, SCM args);
|
|||
*/
|
||||
SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
|
||||
|
||||
SCM_INTERNAL SCM scm_i_define_class_for_vtable (SCM vtable);
|
||||
|
||||
|
||||
SCM_INTERNAL SCM scm_init_goops_builtins (void);
|
||||
SCM_INTERNAL void scm_init_goops (void);
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011 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
|
||||
|
|
@ -54,7 +54,6 @@
|
|||
static SCM required_vtable_fields = SCM_BOOL_F;
|
||||
static SCM required_applicable_fields = SCM_BOOL_F;
|
||||
static SCM required_applicable_with_setter_fields = SCM_BOOL_F;
|
||||
SCM scm_struct_table = SCM_BOOL_F;
|
||||
SCM scm_applicable_struct_vtable_vtable;
|
||||
SCM scm_applicable_struct_with_setter_vtable_vtable;
|
||||
SCM scm_standard_vtable_vtable;
|
||||
|
|
@ -946,27 +945,13 @@ scm_struct_ihashq (SCM obj, unsigned long n, void *closure)
|
|||
return SCM_UNPACK (obj) % n;
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_struct_create_handle (SCM obj)
|
||||
{
|
||||
SCM handle = scm_hash_fn_create_handle_x (scm_struct_table,
|
||||
obj,
|
||||
SCM_BOOL_F,
|
||||
scm_struct_ihashq,
|
||||
(scm_t_assoc_fn) scm_sloppy_assq,
|
||||
0);
|
||||
if (scm_is_false (SCM_CDR (handle)))
|
||||
SCM_SETCDR (handle, scm_cons (SCM_BOOL_F, SCM_BOOL_F));
|
||||
return handle;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0,
|
||||
(SCM vtable),
|
||||
"Return the name of the vtable @var{vtable}.")
|
||||
#define FUNC_NAME s_scm_struct_vtable_name
|
||||
{
|
||||
SCM_VALIDATE_VTABLE (1, vtable);
|
||||
return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)));
|
||||
return SCM_VTABLE_NAME (vtable);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -977,8 +962,10 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0,
|
|||
{
|
||||
SCM_VALIDATE_VTABLE (1, vtable);
|
||||
SCM_VALIDATE_SYMBOL (2, name);
|
||||
SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)),
|
||||
name);
|
||||
SCM_SET_VTABLE_NAME (vtable, name);
|
||||
/* FIXME: remove this, and implement proper struct classes instead.
|
||||
(Vtables *are* classes.) */
|
||||
scm_i_define_class_for_vtable (vtable);
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
@ -1047,7 +1034,6 @@ scm_init_struct ()
|
|||
OBJ once OBJ has undergone class redefinition. */
|
||||
GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits));
|
||||
|
||||
scm_struct_table = scm_make_weak_key_hash_table (scm_from_int (31));
|
||||
required_vtable_fields = scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT);
|
||||
required_applicable_fields = scm_from_locale_string (SCM_APPLICABLE_BASE_LAYOUT);
|
||||
required_applicable_with_setter_fields = scm_from_locale_string (SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT);
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
#ifndef SCM_STRUCT_H
|
||||
#define SCM_STRUCT_H
|
||||
|
||||
/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011 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
|
||||
|
|
@ -165,12 +165,6 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
|
|||
#define SCM_STRUCT_SETTER(X) (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_setter))
|
||||
#define SCM_SET_STRUCT_SETTER(X,P) (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_setter, P))
|
||||
|
||||
#define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X)
|
||||
#define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME)
|
||||
#define SCM_STRUCT_TABLE_CLASS(X) SCM_CDR (X)
|
||||
#define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS)
|
||||
SCM_API SCM scm_struct_table;
|
||||
|
||||
SCM_API SCM scm_standard_vtable_vtable;
|
||||
SCM_API SCM scm_applicable_struct_vtable_vtable;
|
||||
SCM_API SCM scm_applicable_struct_with_setter_vtable_vtable;
|
||||
|
|
@ -191,7 +185,6 @@ SCM_API SCM scm_struct_ref (SCM handle, SCM pos);
|
|||
SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
|
||||
SCM_API SCM scm_struct_vtable (SCM handle);
|
||||
SCM_API SCM scm_struct_vtable_tag (SCM handle);
|
||||
SCM_API SCM scm_struct_create_handle (SCM obj);
|
||||
SCM_API SCM scm_struct_vtable_name (SCM vtable);
|
||||
SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name);
|
||||
SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue