mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 08:40:19 +02:00
* eval.c (SCM_CEVAL, scm_apply): Completed GOOPS support code;
Some indentation fixes. * objects.h (SCM_METACLASS_STANDARD_LAYOUT): Printer field is no longer a user field; New field: class_flags. * objets.c, objects.h: New metaclass: scm_metaclass_operator.
This commit is contained in:
Mikael Djurfeldt
parent
e0d86ad2fb
commit
da7f71d7d5
4 changed files with 301 additions and 80 deletions
|
|
@ -1,3 +1,15 @@
|
|||
Sun Oct 12 14:41:39 1997 Mikael Djurfeldt <mdj@kenneth>
|
||||
|
||||
* ports.h: #include "libguile/print.h"
|
||||
|
||||
* eval.c (SCM_CEVAL, scm_apply): Completed GOOPS support code;
|
||||
Some indentation fixes.
|
||||
|
||||
* objects.h (SCM_METACLASS_STANDARD_LAYOUT): Printer field is no
|
||||
longer a user field; New field: class_flags.
|
||||
|
||||
* objets.c, objects.h: New metaclass: scm_metaclass_operator.
|
||||
|
||||
Tue Oct 7 09:37:24 1997 Mark Galassi <rosalia@cygnus.com>
|
||||
|
||||
* gh_data.c (gh_bool2scm): new function which replaces
|
||||
|
|
|
|||
164
libguile/eval.c
164
libguile/eval.c
|
|
@ -2099,6 +2099,27 @@ evapply:
|
|||
x = SCM_CODE (proc);
|
||||
env = EXTEND_ENV (SCM_CAR (x), SCM_EOL, SCM_ENV (proc));
|
||||
goto cdrxbegin;
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_OPERATORP (proc))
|
||||
{
|
||||
x = (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_0 (proc)
|
||||
: SCM_OPERATOR_PROC_0 (proc));
|
||||
if (SCM_NIMP (x))
|
||||
if (SCM_TYP7 (x) == scm_tc7_subr_1)
|
||||
RETURN (SCM_SUBRF (x) (proc))
|
||||
else if (SCM_CLOSUREP (x))
|
||||
{
|
||||
t.arg1 = proc;
|
||||
proc = x;
|
||||
#ifdef DEVAL
|
||||
debug.info->a.args = scm_cons (t.arg1, SCM_EOL);
|
||||
debug.info->a.proc = proc;
|
||||
#endif
|
||||
goto clos1;
|
||||
}
|
||||
/* Fall through. */
|
||||
}
|
||||
case scm_tc7_contin:
|
||||
case scm_tc7_subr_1:
|
||||
case scm_tc7_subr_2:
|
||||
|
|
@ -2196,6 +2217,7 @@ evapply:
|
|||
goto evap2;
|
||||
#endif
|
||||
case scm_tcs_closures:
|
||||
clos1:
|
||||
x = SCM_CODE (proc);
|
||||
#ifdef DEVAL
|
||||
env = EXTEND_ENV (SCM_CAR (x), debug.info->a.args, SCM_ENV (proc));
|
||||
|
|
@ -2203,12 +2225,13 @@ evapply:
|
|||
env = EXTEND_ENV (SCM_CAR (x), scm_cons (t.arg1, SCM_EOL), SCM_ENV (proc));
|
||||
#endif
|
||||
goto cdrxbegin;
|
||||
case scm_tc7_contin:
|
||||
scm_call_continuation (proc, t.arg1);
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
if (SCM_I_OPERATORP (proc))
|
||||
{
|
||||
x = SCM_ENTITY_PROC_1 (proc);
|
||||
x = (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_1 (proc)
|
||||
: SCM_OPERATOR_PROC_1 (proc));
|
||||
if (SCM_NIMP (x))
|
||||
if (SCM_TYP7 (x) == scm_tc7_subr_2)
|
||||
RETURN (SCM_SUBRF (x) (proc, t.arg1))
|
||||
else if (SCM_CLOSUREP (x))
|
||||
|
|
@ -2224,6 +2247,8 @@ evapply:
|
|||
}
|
||||
/* Fall through. */
|
||||
}
|
||||
case scm_tc7_contin:
|
||||
scm_call_continuation (proc, t.arg1);
|
||||
case scm_tc7_subr_2:
|
||||
case scm_tc7_subr_0:
|
||||
case scm_tc7_subr_3:
|
||||
|
|
@ -2273,7 +2298,8 @@ evapply:
|
|||
#else
|
||||
RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc), proc,
|
||||
scm_cons2 (t.arg1, arg2,
|
||||
scm_cons (scm_eval_args (x, env), SCM_EOL))));
|
||||
scm_cons (scm_eval_args (x, env),
|
||||
SCM_EOL))));
|
||||
#endif
|
||||
/* case scm_tc7_cclo:
|
||||
x = scm_cons(arg2, scm_eval_args(x, env));
|
||||
|
|
@ -2283,9 +2309,12 @@ evapply:
|
|||
goto evap3; */
|
||||
#endif
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
if (SCM_I_OPERATORP (proc))
|
||||
{
|
||||
x = SCM_ENTITY_PROC_2 (proc);
|
||||
x = (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_2 (proc)
|
||||
: SCM_OPERATOR_PROC_2 (proc));
|
||||
if (SCM_NIMP (x))
|
||||
if (SCM_TYP7 (x) == scm_tc7_subr_3)
|
||||
RETURN (SCM_SUBRF (x) (proc, t.arg1, arg2))
|
||||
else if (SCM_CLOSUREP (x))
|
||||
|
|
@ -2298,8 +2327,8 @@ evapply:
|
|||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (x)),
|
||||
scm_cons2 (proc, t.arg1,
|
||||
scm_cons (arg2, env)),
|
||||
SCM_ENV (proc));
|
||||
x = SCM_CODE (proc);
|
||||
SCM_ENV (x));
|
||||
x = SCM_CODE (x);
|
||||
goto cdrxbegin;
|
||||
}
|
||||
/* Fall through. */
|
||||
|
|
@ -2316,9 +2345,12 @@ evapply:
|
|||
case scm_tcs_closures:
|
||||
clos2:
|
||||
#ifdef DEVAL
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), debug.info->a.args, SCM_ENV (proc));
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)),
|
||||
debug.info->a.args,
|
||||
SCM_ENV (proc));
|
||||
#else
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)), scm_cons2 (t.arg1, arg2, SCM_EOL), SCM_ENV (proc));
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (proc)),
|
||||
scm_cons2 (t.arg1, arg2, SCM_EOL), SCM_ENV (proc));
|
||||
#endif
|
||||
x = SCM_CODE (proc);
|
||||
goto cdrxbegin;
|
||||
|
|
@ -2329,21 +2361,23 @@ evapply:
|
|||
scm_deval_args (x, env, SCM_CDRLOC (SCM_CDR (debug.info->a.args))));
|
||||
#endif
|
||||
ENTER_APPLY;
|
||||
evap3:
|
||||
switch (SCM_TYP7 (proc))
|
||||
{ /* have 3 or more arguments */
|
||||
#ifdef DEVAL
|
||||
case scm_tc7_subr_3:
|
||||
SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs);
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CAR (SCM_CDR (SCM_CDR (debug.info->a.args)))));
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2,
|
||||
SCM_CADDR (debug.info->a.args)));
|
||||
case scm_tc7_asubr:
|
||||
#ifdef BUILTIN_RPASUBR
|
||||
t.arg1 = SCM_SUBRF(proc)(t.arg1, arg2);
|
||||
arg2 = SCM_CDR (SCM_CDR (debug.info->a.args));
|
||||
do {
|
||||
do
|
||||
{
|
||||
t.arg1 = SCM_SUBRF(proc)(t.arg1, SCM_CAR (arg2));
|
||||
arg2 = SCM_CDR (arg2);
|
||||
} while (SCM_NIMP (arg2));
|
||||
}
|
||||
while (SCM_NIMP (arg2));
|
||||
RETURN (t.arg1)
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_rpsubr:
|
||||
|
|
@ -2351,18 +2385,24 @@ evapply:
|
|||
if (SCM_FALSEP (SCM_SUBRF (proc) (t.arg1, arg2)))
|
||||
RETURN (SCM_BOOL_F)
|
||||
t.arg1 = SCM_CDR (SCM_CDR (debug.info->a.args));
|
||||
do {
|
||||
do
|
||||
{
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, SCM_CAR (t.arg1))))
|
||||
RETURN (SCM_BOOL_F)
|
||||
arg2 = SCM_CAR (t.arg1);
|
||||
t.arg1 = SCM_CDR (t.arg1);
|
||||
} while (SCM_NIMP (t.arg1));
|
||||
}
|
||||
while (SCM_NIMP (t.arg1));
|
||||
RETURN (SCM_BOOL_T)
|
||||
#else /* BUILTIN_RPASUBR */
|
||||
RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, SCM_CDR (SCM_CDR (debug.info->a.args)), SCM_EOL)))
|
||||
RETURN (SCM_APPLY (proc, t.arg1,
|
||||
scm_acons (arg2,
|
||||
SCM_CDR (SCM_CDR (debug.info->a.args)),
|
||||
SCM_EOL)))
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_lsubr_2:
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, SCM_CDR (SCM_CDR (debug.info->a.args))))
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2,
|
||||
SCM_CDR (SCM_CDR (debug.info->a.args))))
|
||||
case scm_tc7_lsubr:
|
||||
RETURN (SCM_SUBRF (proc) (debug.info->a.args))
|
||||
#ifdef CCLO
|
||||
|
|
@ -2383,26 +2423,31 @@ evapply:
|
|||
case scm_tc7_asubr:
|
||||
#ifdef BUILTIN_RPASUBR
|
||||
t.arg1 = SCM_SUBRF (proc) (t.arg1, arg2);
|
||||
do {
|
||||
do
|
||||
{
|
||||
t.arg1 = SCM_SUBRF(proc)(t.arg1, EVALCAR(x, env));
|
||||
x = SCM_CDR(x);
|
||||
} while (SCM_NIMP (x));
|
||||
}
|
||||
while (SCM_NIMP (x));
|
||||
RETURN (t.arg1)
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_rpsubr:
|
||||
#ifdef BUILTIN_RPASUBR
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (t.arg1, arg2)))
|
||||
RETURN (SCM_BOOL_F)
|
||||
do {
|
||||
do
|
||||
{
|
||||
t.arg1 = EVALCAR (x, env);
|
||||
if (SCM_FALSEP (SCM_SUBRF (proc) (arg2, t.arg1)))
|
||||
RETURN (SCM_BOOL_F)
|
||||
arg2 = t.arg1;
|
||||
x = SCM_CDR (x);
|
||||
} while (SCM_NIMP (x));
|
||||
}
|
||||
while (SCM_NIMP (x));
|
||||
RETURN (SCM_BOOL_T)
|
||||
#else /* BUILTIN_RPASUBR */
|
||||
RETURN (SCM_APPLY (proc, t.arg1, scm_acons (arg2, scm_eval_args (x, env), SCM_EOL)));
|
||||
RETURN (SCM_APPLY (proc, t.arg1,
|
||||
scm_acons (arg2, scm_eval_args (x, env), SCM_EOL)));
|
||||
#endif /* BUILTIN_RPASUBR */
|
||||
case scm_tc7_lsubr_2:
|
||||
RETURN (SCM_SUBRF (proc) (t.arg1, arg2, scm_eval_args (x, env)));
|
||||
|
|
@ -2423,8 +2468,44 @@ evapply:
|
|||
goto cdrxbegin;
|
||||
#endif /* DEVAL */
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
;
|
||||
if (SCM_I_OPERATORP (proc))
|
||||
{
|
||||
SCM p = (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_3 (proc)
|
||||
: SCM_OPERATOR_PROC_3 (proc));
|
||||
if (SCM_NIMP (p))
|
||||
if (SCM_TYP7 (p) == scm_tc7_lsubr_2)
|
||||
#ifdef DEVAL
|
||||
RETURN (SCM_SUBRF (p) (proc, t.arg1,
|
||||
scm_cons (arg2, SCM_CDDR (debug.info->a.args))))
|
||||
#else
|
||||
RETURN (SCM_SUBRF (p) (proc, t.arg1,
|
||||
scm_cons (arg2,
|
||||
scm_eval_args (x, env))))
|
||||
#endif
|
||||
else if (SCM_CLOSUREP (p))
|
||||
{
|
||||
#ifdef DEVAL
|
||||
SCM_SET_ARGSREADY (debug);
|
||||
debug.info->a.args = scm_cons (proc, debug.info->a.args);
|
||||
debug.info->a.proc = p;
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (p)),
|
||||
scm_cons2 (proc, t.arg1,
|
||||
scm_cons (arg2,
|
||||
SCM_CDDDR (debug.info->a.args))),
|
||||
SCM_ENV (p));
|
||||
#else
|
||||
env = EXTEND_ENV (SCM_CAR (SCM_CODE (p)),
|
||||
scm_cons2 (proc, t.arg1,
|
||||
scm_cons (arg2,
|
||||
scm_eval_args (x, env))),
|
||||
SCM_ENV (p));
|
||||
#endif
|
||||
x = SCM_CODE (p);
|
||||
goto cdrxbegin;
|
||||
}
|
||||
/* Fall through. */
|
||||
}
|
||||
case scm_tc7_subr_2:
|
||||
case scm_tc7_subr_1o:
|
||||
case scm_tc7_subr_2o:
|
||||
|
|
@ -2777,8 +2858,35 @@ tail:
|
|||
goto tail;
|
||||
#endif
|
||||
case scm_tcs_cons_gloc:
|
||||
if (SCM_I_ENTITYP (proc))
|
||||
;
|
||||
if (SCM_I_OPERATORP (proc))
|
||||
{
|
||||
#ifdef DEVAL
|
||||
args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args);
|
||||
#else
|
||||
args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args));
|
||||
#endif
|
||||
arg1 = proc;
|
||||
proc = (SCM_NULLP (args)
|
||||
? (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_0 (proc)
|
||||
: SCM_OPERATOR_PROC_0 (proc))
|
||||
: SCM_NULLP (SCM_CDR (args))
|
||||
? (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_1 (proc)
|
||||
: SCM_OPERATOR_PROC_1 (proc))
|
||||
: SCM_NULLP (SCM_CDDR (args))
|
||||
? (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_2 (proc)
|
||||
: SCM_OPERATOR_PROC_2 (proc))
|
||||
: (SCM_I_ENTITYP (proc)
|
||||
? SCM_ENTITY_PROC_3 (proc)
|
||||
: SCM_OPERATOR_PROC_3 (proc)));
|
||||
#ifdef DEVAL
|
||||
debug.vect[0].a.proc = proc;
|
||||
debug.vect[0].a.args = scm_cons (arg1, args);
|
||||
#endif
|
||||
goto tail;
|
||||
}
|
||||
wrongnumargs:
|
||||
scm_wrong_num_args (proc);
|
||||
default:
|
||||
|
|
|
|||
|
|
@ -40,9 +40,9 @@
|
|||
* If you do not wish that, delete this exception notice. */
|
||||
|
||||
|
||||
/* This file contains those minimal pieces of the Guile Object
|
||||
* Oriented Programming System which needs to be included in
|
||||
* libguile.
|
||||
/* This file and objects.h contains those minimal pieces of the Guile
|
||||
* Object Oriented Programming System which need to be included in
|
||||
* libguile. See the comments in objects.h.
|
||||
*/
|
||||
|
||||
#include "_scm.h"
|
||||
|
|
@ -53,7 +53,7 @@
|
|||
|
||||
|
||||
SCM scm_metaclass_standard;
|
||||
SCM *scm_entity_vtable;
|
||||
SCM scm_metaclass_operator;
|
||||
|
||||
void
|
||||
scm_init_objects ()
|
||||
|
|
@ -63,6 +63,11 @@ scm_init_objects ()
|
|||
SCM mt = scm_make_vtable_vtable (ml, SCM_INUM0,
|
||||
SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
|
||||
|
||||
SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
|
||||
SCM ol = scm_make_struct_layout (os);
|
||||
SCM ot = scm_make_vtable_vtable (ol, SCM_INUM0,
|
||||
SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
|
||||
|
||||
SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
|
||||
SCM el = scm_make_struct_layout (es);
|
||||
SCM et = scm_make_struct (mt, SCM_INUM0,
|
||||
|
|
@ -70,6 +75,8 @@ scm_init_objects ()
|
|||
|
||||
scm_sysintern ("<standard-metaclass>", mt);
|
||||
scm_metaclass_standard = mt;
|
||||
scm_sysintern ("<operator-metaclass>", ot);
|
||||
scm_metaclass_operator = ot;
|
||||
SCM_SET_CLASS_FLAGS (et, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY);
|
||||
scm_sysintern ("<entity-class>", et);
|
||||
scm_entity_vtable = SCM_STRUCT_DATA (et);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -45,20 +45,92 @@
|
|||
* If you do not wish that, delete this exception notice. */
|
||||
|
||||
|
||||
/* This file and objects.c contains those minimal pieces of the Guile
|
||||
* Object Oriented Programming System which need to be included in
|
||||
* libguile.
|
||||
*
|
||||
* {Objects and structs}
|
||||
*
|
||||
* Objects are currently based upon structs. Although the struct
|
||||
* implementation will change thoroughly in the future, objects will
|
||||
* still be based upon structs.
|
||||
*/
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
#include "libguile/struct.h"
|
||||
|
||||
|
||||
|
||||
#define SCM_I_ENTITYP(OBJ)\
|
||||
(SCM_STRUCT_VTABLE_DATA (OBJ) == scm_entity_vtable)
|
||||
#define SCM_ENTITY(OBJ) ((scm_entity*) SCM_STRUCT_DATA (OBJ))
|
||||
#define SCM_ENTITY_PROC_0(OBJ) (SCM_ENTITY (OBJ)->proc0)
|
||||
#define SCM_ENTITY_PROC_1(OBJ) (SCM_ENTITY (OBJ)->proc1)
|
||||
#define SCM_ENTITY_PROC_2(OBJ) (SCM_ENTITY (OBJ)->proc2)
|
||||
#define SCM_ENTITY_PROC_3(OBJ) (SCM_ENTITY (OBJ)->proc3)
|
||||
/* {Class flags}
|
||||
*
|
||||
* These are used for efficient identification of instances of a
|
||||
* certain class or its subclasses when traversal of the inheritance
|
||||
* graph would be too costly.
|
||||
*/
|
||||
#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class)[scm_struct_i_tag])
|
||||
#define SCM_OBJ_CLASS_FLAGS(obj)\
|
||||
(SCM_STRUCT_VTABLE_DATA (obj)[scm_struct_i_tag])
|
||||
#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
|
||||
#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
|
||||
#define SCM_CLASSF_MASK (0xFF << 24)
|
||||
|
||||
#define SCM_METACLASS_STANDARD_LAYOUT "pwpwpw"
|
||||
/* Operator classes need to be identified in the evaluator. */
|
||||
#define SCM_CLASSF_OPERATOR (1L << 30)
|
||||
/* Entities also have SCM_CLASSF_OPERATOR set in their vtable. */
|
||||
#define SCM_CLASSF_ENTITY (1L << 29)
|
||||
|
||||
#define SCM_I_OPERATORP(obj)\
|
||||
((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR) != 0)
|
||||
#define SCM_OPERATOR_CLASS(obj)\
|
||||
((struct scm_metaclass_operator *) SCM_STRUCT_DATA (obj))
|
||||
#define SCM_OBJ_OPERATOR_CLASS(obj)\
|
||||
((struct scm_metaclass_operator *) SCM_STRUCT_VTABLE_DATA (obj))
|
||||
#define SCM_OPERATOR_PROC_0(obj) (SCM_OBJ_OPERATOR_CLASS (obj)->proc0)
|
||||
#define SCM_OPERATOR_PROC_1(obj) (SCM_OBJ_OPERATOR_CLASS (obj)->proc1)
|
||||
#define SCM_OPERATOR_PROC_2(obj) (SCM_OBJ_OPERATOR_CLASS (obj)->proc2)
|
||||
#define SCM_OPERATOR_PROC_3(obj) (SCM_OBJ_OPERATOR_CLASS (obj)->proc3)
|
||||
|
||||
#define SCM_I_ENTITYP(obj)\
|
||||
((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0)
|
||||
#define SCM_ENTITY(obj) ((scm_entity*) SCM_STRUCT_DATA (obj))
|
||||
#define SCM_ENTITY_PROC_0(obj) (SCM_ENTITY (obj)->proc0)
|
||||
#define SCM_ENTITY_PROC_1(obj) (SCM_ENTITY (obj)->proc1)
|
||||
#define SCM_ENTITY_PROC_2(obj) (SCM_ENTITY (obj)->proc2)
|
||||
#define SCM_ENTITY_PROC_3(obj) (SCM_ENTITY (obj)->proc3)
|
||||
|
||||
/* {Operator classes}
|
||||
*
|
||||
* Instances of operator classes can work as operators, i. e., they
|
||||
* can be applied to arguments just as if they were ordinary
|
||||
* procedures.
|
||||
*
|
||||
* For instances of operator classes, the procedures to be applied are
|
||||
* stored in four dedicated slots in the associated class object.
|
||||
* Which one is selected depends on the number of arguments in the
|
||||
* application.
|
||||
*
|
||||
* If zero arguments are passed, the first will be selected.
|
||||
* If one argument is passed, the second will be selected.
|
||||
* If two arguments are passed, the third will be selected.
|
||||
* If three or more arguments are passed, the fourth will be selected.
|
||||
*
|
||||
* This is complicated and may seem gratuitous but has to do with the
|
||||
* architecture of the evaluator. Using only one procedure would
|
||||
* result in a great deal less efficient application, loss of
|
||||
* tail-recursion and would be difficult to reconcile with the
|
||||
* debugging evaluator.
|
||||
*
|
||||
* Also, using this "forked" application in low-level code has the
|
||||
* advantage of speeding up some code. An example is method dispatch
|
||||
* for generic operators applied to few arguments. On the user level,
|
||||
* the "forked" application will be hidden by mechanisms in the GOOPS
|
||||
* package.
|
||||
*
|
||||
* Operator classes have the metaclass <operator-metaclass>.
|
||||
*
|
||||
* An example of an operator class is the class <tk-command>.
|
||||
*/
|
||||
#define SCM_METACLASS_STANDARD_LAYOUT "pwpw"
|
||||
struct scm_metaclass_standard {
|
||||
SCM layout;
|
||||
SCM vcell;
|
||||
|
|
@ -68,6 +140,28 @@ struct scm_metaclass_standard {
|
|||
SCM direct_slots;
|
||||
};
|
||||
|
||||
#define SCM_METACLASS_OPERATOR_LAYOUT "pwpwpwpwpwpw"
|
||||
struct scm_metaclass_operator {
|
||||
SCM layout;
|
||||
SCM vcell;
|
||||
SCM vtable;
|
||||
SCM print;
|
||||
SCM direct_supers;
|
||||
SCM direct_slots;
|
||||
SCM proc0;
|
||||
SCM proc1;
|
||||
SCM proc2;
|
||||
SCM proc3;
|
||||
};
|
||||
|
||||
/* {Entity classes}
|
||||
*
|
||||
* For instances of entity classes (entities), the procedures to be
|
||||
* applied are stored in the instance itself rather than in the class
|
||||
* object as is the case for instances of operator classes (see above).
|
||||
*
|
||||
* An example of an entity class is the class of generic methods.
|
||||
*/
|
||||
#define SCM_ENTITY_LAYOUT "pwpwpwpw"
|
||||
typedef struct scm_entity {
|
||||
SCM proc0;
|
||||
|
|
@ -77,7 +171,7 @@ typedef struct scm_entity {
|
|||
} scm_entity;
|
||||
|
||||
extern SCM scm_metaclass_standard;
|
||||
extern SCM *scm_entity_vtable;
|
||||
extern SCM scm_metaclass_operator;
|
||||
|
||||
extern void scm_init_objects SCM_P ((void));
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue