mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00
Code Activity

* objects.c (scm_i_make_class_object): Renamed from

Browse source 
make_class_object; exported; error checking moved to
scm_make_class_object and scm_make_subclass_object.
(scm_make_class_object, scm_make_subclass_object): Use
scm_i_make_class_object.
(scm_make_subclass_object): Let the subclass have same metaclass
as the superclass.
This commit is contained in:
Mikael Djurfeldt 1998-11-15 16:16:06 +00:00
parent a6e350ddef
commit 036737fce8
3 changed files with 30 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

10
libguile/ChangeLog
View file

@ -1,3 +1,13 @@
1998-11-14 Mikael Djurfeldt <mdj@barbara.nada.kth.se>
* objects.c (scm_i_make_class_object): Renamed from
make_class_object; exported; error checking moved to
scm_make_class_object and scm_make_subclass_object.
(scm_make_class_object, scm_make_subclass_object): Use
scm_i_make_class_object.
(scm_make_subclass_object): Let the subclass have same metaclass
as the superclass.
1998-11-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se> 1998-11-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* debug.c (scm_debug_options): Bugfix: Set the value of * debug.c (scm_debug_options): Bugfix: Set the value of

40
libguile/objects.c
View file

@ -150,20 +150,13 @@ scm_set_object_procedure_x (SCM obj, SCM procs)
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
static SCM SCM
make_class_object (SCM meta, scm_i_make_class_object (SCM meta,
SCM pl, SCM layout_string,
SCM layout, unsigned long flags)
unsigned long flags,
char* subr)
{ {
SCM c; SCM c;
SCM_ASSERT (SCM_NIMP (meta) && SCM_STRUCTP (meta), meta, SCM_ARG1, subr); SCM layout = scm_make_struct_layout (layout_string);
SCM_ASSERT (SCM_NIMP (layout) && SCM_STRINGP (layout),
layout,
SCM_ARG2,
subr);
layout = scm_make_struct_layout (scm_string_append (SCM_LIST2 (pl, layout)));
c = scm_make_struct (meta, c = scm_make_struct (meta,
SCM_INUM0, SCM_INUM0,
SCM_LIST4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL)); SCM_LIST4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL));
@ -177,13 +170,13 @@ SCM
scm_make_class_object (SCM metaclass, SCM layout) scm_make_class_object (SCM metaclass, SCM layout)
{ {
unsigned long flags = 0; unsigned long flags = 0;
SCM_ASSERT (SCM_NIMP (metaclass) && SCM_STRUCTP (metaclass),
metaclass, SCM_ARG1, s_make_class_object);
SCM_ASSERT (SCM_NIMP (layout) && SCM_STRINGP (layout),
layout, SCM_ARG2, s_make_class_object);
if (metaclass == scm_metaclass_operator) if (metaclass == scm_metaclass_operator)
flags = SCM_CLASSF_OPERATOR; flags = SCM_CLASSF_OPERATOR;
return make_class_object (metaclass, return scm_i_make_class_object (metaclass, layout, flags);
scm_nullstr,
layout,
flags,
s_make_class_object);
} }
SCM_PROC (s_make_subclass_object, "make-subclass-object", 2, 0, 0, scm_make_subclass_object); SCM_PROC (s_make_subclass_object, "make-subclass-object", 2, 0, 0, scm_make_subclass_object);
@ -196,13 +189,16 @@ scm_make_subclass_object (SCM class, SCM layout)
class, class,
SCM_ARG1, SCM_ARG1,
s_make_subclass_object); s_make_subclass_object);
pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout]; SCM_ASSERT (SCM_NIMP (layout) && SCM_STRINGP (layout),
pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
return make_class_object (scm_metaclass_standard,
pl,
layout, layout,
SCM_CLASS_FLAGS (class), SCM_ARG2,
s_make_subclass_object); s_make_subclass_object);
pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
/* Convert symbol->string */
pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (SCM_LIST2 (pl, layout)),
SCM_CLASS_FLAGS (class));
} }
void void

2
libguile/objects.h
View file

@ -177,6 +177,8 @@ extern SCM scm_set_object_procedure_x (SCM obj, SCM procs);
extern SCM scm_make_class_object (SCM metaclass, SCM layout); extern SCM scm_make_class_object (SCM metaclass, SCM layout);
extern SCM scm_make_subclass_object (SCM class, SCM layout); extern SCM scm_make_subclass_object (SCM class, SCM layout);
extern SCM scm_i_make_class_object (SCM metaclass, SCM layout_string,
unsigned long flags);
extern void scm_init_objects SCM_P ((void)); extern void scm_init_objects SCM_P ((void));
#endif /* OBJECTSH */ #endif /* OBJECTSH */