-/* Copyright (C) 1995,1996,1999,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004 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
SCM scm_class_procedure, scm_class_string, scm_class_symbol;
SCM scm_class_procedure_with_setter, scm_class_primitive_generic;
SCM scm_class_vector, scm_class_null;
-SCM scm_class_integer, scm_class_real, scm_class_complex;
+SCM scm_class_integer, scm_class_real, scm_class_complex, scm_class_fraction;
SCM scm_class_unknown;
SCM *scm_port_class = 0;
case scm_tc3_imm24:
if (SCM_CHARP (x))
return scm_class_char;
+ else if (scm_is_bool (x))
+ return scm_class_boolean;
+ else if (scm_is_null (x))
+ return scm_class_null;
else
- {
- switch (SCM_ISYMNUM (x))
- {
- case SCM_ISYMNUM (SCM_BOOL_F):
- case SCM_ISYMNUM (SCM_BOOL_T):
- return scm_class_boolean;
- case SCM_ISYMNUM (SCM_EOL):
- return scm_class_null;
- default:
- return scm_class_unknown;
- }
- }
+ return scm_class_unknown;
case scm_tc3_cons:
switch (SCM_TYP7 (x))
return scm_class_vector;
case scm_tc7_string:
return scm_class_string;
+ case scm_tc7_number:
+ switch SCM_TYP16 (x) {
+ case scm_tc16_big:
+ return scm_class_integer;
+ case scm_tc16_real:
+ return scm_class_real;
+ case scm_tc16_complex:
+ return scm_class_complex;
+ case scm_tc16_fraction:
+ return scm_class_fraction;
+ }
case scm_tc7_asubr:
case scm_tc7_subr_0:
case scm_tc7_subr_1:
else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
{
/* Goops object */
- if (! SCM_FALSEP (SCM_OBJ_CLASS_REDEF (x)))
+ if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x)))
scm_change_object_class (x,
SCM_CLASS_OF (x), /* old */
SCM_OBJ_CLASS_REDEF (x)); /* new */
{
/* ordinary struct */
SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x));
- if (!SCM_FALSEP (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
+ if (scm_is_true (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle));
else
{
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
- SCM class = scm_make_extended_class (!SCM_FALSEP (name)
- ? SCM_SYMBOL_CHARS (name)
+ SCM class = scm_make_extended_class (scm_is_true (name)
+ ? scm_i_symbol_chars (name)
: 0,
SCM_I_OPERATORP (x));
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
}
}
default:
- if (SCM_CONSP (x))
+ if (scm_is_pair (x))
return scm_class_pair;
else
return scm_class_unknown;
SCM
scm_mcache_lookup_cmethod (SCM cache, SCM args)
{
- long i, n, end, mask;
+ unsigned long i, mask, n, end;
SCM ls, methods, z = SCM_CDDR (cache);
- n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
+ n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z);
- if (SCM_INUMP (methods))
+ if (SCM_VECTORP (methods))
+ {
+ /* cache format #1: prepare for linear search */
+ mask = -1;
+ i = 0;
+ end = SCM_VECTOR_LENGTH (methods);
+ }
+ else
{
/* cache format #2: compute a hash value */
- long hashset = SCM_INUM (methods);
+ unsigned long hashset = scm_to_ulong (methods);
long j = n;
z = SCM_CDDR (z);
- mask = SCM_INUM (SCM_CAR (z));
+ mask = scm_to_ulong (SCM_CAR (z));
methods = SCM_CADR (z);
i = 0;
ls = args;
- if (!SCM_NULLP (ls))
+ if (!scm_is_null (ls))
do
{
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
[scm_si_hashsets + hashset];
ls = SCM_CDR (ls);
}
- while (j-- && !SCM_NULLP (ls));
+ while (j-- && !scm_is_null (ls));
i &= mask;
end = i;
}
- else /* SCM_VECTORP (methods) */
- {
- /* cache format #1: prepare for linear search */
- mask = -1;
- i = 0;
- end = SCM_VECTOR_LENGTH (methods);
- }
/* Search for match */
do
long j = n;
z = SCM_VELTS (methods)[i];
ls = args; /* list of arguments */
- if (!SCM_NULLP (ls))
+ if (!scm_is_null (ls))
do
{
/* More arguments than specifiers => CLASS != ENV */
- if (! SCM_EQ_P (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
+ if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
goto next_method;
ls = SCM_CDR (ls);
z = SCM_CDR (z);
}
- while (j-- && !SCM_NULLP (ls));
+ while (j-- && !scm_is_null (ls));
/* Fewer arguments than specifiers => CAR != ENV */
- if (SCM_NULLP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z)))
+ if (scm_is_null (SCM_CAR (z)) || scm_is_pair (SCM_CAR (z)))
return z;
next_method:
i = (i + 1) & mask;
scm_mcache_compute_cmethod (SCM cache, SCM args)
{
SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
- if (SCM_FALSEP (cmethod))
+ if (scm_is_false (cmethod))
/* No match - memoize */
return scm_memoize_method (cache, args);
return cmethod;
"Return @code{#t} if @var{obj} is an entity.")
#define FUNC_NAME s_scm_entity_p
{
- return SCM_BOOL(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj));
+ return scm_from_bool(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj));
}
#undef FUNC_NAME
"Return @code{#t} if @var{obj} is an operator.")
#define FUNC_NAME s_scm_operator_p
{
- return SCM_BOOL(SCM_STRUCTP (obj)
+ return scm_from_bool(SCM_STRUCTP (obj)
&& SCM_I_OPERATORP (obj)
&& !SCM_I_ENTITYP (obj));
}
unsigned long flags = 0;
SCM_VALIDATE_STRUCT (1, metaclass);
SCM_VALIDATE_STRING (2, layout);
- if (SCM_EQ_P (metaclass, scm_metaclass_operator))
+ if (scm_is_eq (metaclass, scm_metaclass_operator))
flags = SCM_CLASSF_OPERATOR;
return scm_i_make_class_object (metaclass, layout, flags);
}
SCM_VALIDATE_STRUCT (1, class);
SCM_VALIDATE_STRING (2, layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
- /* Convert symbol->string */
- pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));
+ pl = scm_symbol_to_string (pl);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (scm_list_2 (pl, layout)),
SCM_CLASS_FLAGS (class));
void
scm_init_objects ()
{
- SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT);
+ SCM ms = scm_from_locale_string (SCM_METACLASS_STANDARD_LAYOUT);
SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
- SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
+ SCM os = scm_from_locale_string (SCM_METACLASS_OPERATOR_LAYOUT);
SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
- SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
+ SCM es = scm_from_locale_string (SCM_ENTITY_LAYOUT);
SCM el = scm_make_struct_layout (es);
SCM et = scm_make_struct (mt, SCM_INUM0,
scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
HCoop / bpt / guile.git / blobdiff