Diff of /src/c/gfun.d [661db1] .. [e5072a] Maximize Restore

  Switch to side-by-side view

--- a/src/c/gfun.d
+++ b/src/c/gfun.d
@@ -13,114 +13,22 @@
 */
 
 #include "ecl.h"
+#include "internal.h"
 
 cl_object
-si_allocate_gfun(cl_object name, cl_object arg_no, cl_object ht)
+si_set_funcallable(cl_object instance, cl_object flag)
 {
-	cl_object x;
-	int n, i;
-
-	if (type_of(ht) != t_hashtable)
-		FEwrong_type_argument(@'hash-table', ht);
-
-	x = cl_alloc_object(t_gfun);
-	x->gfun.specializers = NULL; /* for GC sake */
-	x->gfun.name = name;
-	x->gfun.method_hash = ht;
-	n = fixnnint(arg_no);
-	x->gfun.arg_no = n;
-	x->gfun.specializers = (cl_object *)cl_alloc_align(sizeof(cl_object)*n, sizeof(cl_object));
-	for (i = 0;  i < n;  i++)
-		x->gfun.specializers[i] = OBJNULL;
-	x->gfun.instance = Cnil;
-	@(return x)
+	if (type_of(instance) != t_instance)
+		FEwrong_type_argument(@'instance', instance);
+	instance->instance.isgf = !Null(flag);
+	@(return instance)
 }
 
 cl_object
-si_gfun_name(cl_object x)
+si_generic_function_p(cl_object instance)
 {
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	@(return x->gfun.name)
-}
-
-cl_object
-si_gfun_name_set(cl_object x, cl_object name)
-{
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	x->gfun.name = name;
-	@(return x)
-}
-
-cl_object
-si_gfun_method_ht(cl_object x)
-{
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	@(return x->gfun.method_hash)
-}
-
-cl_object
-si_gfun_method_ht_set(cl_object x, cl_object y)
-{
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	if (type_of(y) != t_hashtable)
-		FEwrong_type_argument(@'hash-table', y);
-	x->gfun.method_hash = y;
-	@(return x)
-}
-
-cl_object
-si_gfun_spec_how_ref(cl_object x, cl_object y)
-{
-	cl_fixnum i;
-
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	if (!FIXNUMP(y) ||
-	    (i = fix(y)) < 0 || i >= x->gfun.arg_no)
-		FEerror("~S is an illegal spec_how index.", 1, y);
-	@(return x->gfun.specializers[i])
-}
-
-cl_object
-si_gfun_spec_how_set(cl_object x, cl_object y, cl_object spec)
-{
-	int i;
-
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	if (!FIXNUMP(y) || (i = fix(y)) >= x->gfun.arg_no)
-		FEerror("~S is an illegal spec_how index.", 1, y);
-	x->gfun.specializers[i] = spec;
-	@(return spec)
-}
-
-cl_object
-si_gfun_instance(cl_object x)
-{
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	@(return x->gfun.instance)
-}
-
-cl_object
-si_gfun_instance_set(cl_object x, cl_object y)
-{
-	if (type_of(x) != t_gfun)
-		FEwrong_type_argument(@'dispatch-function', x);
-	if (type_of(y) != t_instance)
-		FEwrong_type_argument(@'instance', y);
-	x->gfun.instance = y;
-	@(return x)
-}
-
-cl_object
-si_gfunp(cl_object x)
-{
-	@(return ((type_of(x) == t_gfun)? Ct : Cnil))
+	@(return (((type_of(instance) != t_instance) &&
+		   (instance->instance.isgf))? Ct : Cnil))
 }
 
 /*
@@ -159,21 +67,6 @@
 	internal_error("get_meth_hash");
 }
 
-cl_object
-si_method_ht_get(cl_object keylist, cl_object table)
-{
-	struct hashtable_entry *e;
-
-	{  int i, argn = length(keylist);
-	   cl_object keys[argn];	/* __GNUC__ */
-
-	   for (i = 0; i < argn; i++, keylist = CDR(keylist))
-	     keys[i] = CAR(keylist);
-	   e = get_meth_hash(keys, argn, table);
-	}
-	@(return ((e->key == OBJNULL)? Cnil : e->value))
-}
-
 static void
 set_meth_hash(cl_object *keys, int argno, cl_object hashtable, cl_object value)
 {
@@ -192,44 +85,46 @@
 }
 
 cl_object
-compute_method(int narg, cl_object fun, cl_object *args)
+compute_method(int narg, cl_object gf, cl_object *args)
 {
 	cl_object func;
+	int i, spec_no;
+	struct hashtable_entry *e;
+	cl_object spec_how_list = GFUN_SPEC(gf);
+	cl_object table = GFUN_HASH(gf);
+	cl_object argtype[narg]; /* __GNUC__ */
 
-	{ int i, spec_no;
-	  struct hashtable_entry *e;
-	  cl_object *spec_how = fun->gfun.specializers;
-	  cl_object argtype[narg]; /* __GNUC__ */
+	for (i = 0, spec_no = 0; spec_how_list != Cnil; i++) {
+		cl_object spec_how = CAR(spec_how_list);
+		if (spec_how != Cnil) {
+			if (i >= narg)
+				FEwrong_num_arguments(gf);
+			argtype[spec_no++] =
+				(ATOM(spec_how) ||
+				 Null(memql(args[i], spec_how))) ?
+				cl_type_of(args[i]) :
+				args[i];
+		}
+		spec_how_list = CDR(spec_how_list);
+	}
 
-	  if (narg < fun->gfun.arg_no)
-	      FEwrong_num_arguments(fun->gfun.name);
-	  for (i = 0, spec_no = 0; i < fun->gfun.arg_no; i++, spec_how++) {
-	    if (*spec_how != Cnil)
-	      argtype[spec_no++] = (ATOM(*spec_how) ||
-				    Null(memql(args[i], *spec_how))) ?
-				      cl_type_of(args[i]) :
-					args[i];
-	  }
+	e = get_meth_hash(argtype, spec_no, table);
 
-	  e = get_meth_hash(argtype, spec_no, fun->gfun.method_hash);
-
-	  if (e->key == OBJNULL) { 
-	    /* method not cached */
-	    register cl_object gf = fun->gfun.instance;
-	    cl_object methods, meth_comb, meth_args, arglist = Cnil;
-
-	    i = narg;
-	    while (i-- > 0)
-	      arglist = CONS(args[i], arglist);
-	    methods = funcall(3, @'compute-applicable-methods', gf, arglist);
-	    meth_comb = instance_ref(gf, 2);
-	    func = funcall(4, @'si::compute-effective-method', gf, meth_comb,
-			   methods);
-	    /* update cache */
-	    set_meth_hash(argtype, spec_no, fun->gfun.method_hash, func);
-	  } else
-	    /* method is already cached */
-	    func = e->value;
+	if (e->key == OBJNULL) { 
+		/* method not cached */
+		cl_object methods, meth_comb, arglist = Cnil;
+		i = narg;
+		while (i-- > 0)
+			arglist = CONS(args[i], arglist);
+		methods = funcall(3, @'compute-applicable-methods', gf,
+				  arglist);
+		func = funcall(4, @'si::compute-effective-method', gf,
+			       GFUN_COMB(gf), methods);
+		/* update cache */
+		set_meth_hash(argtype, spec_no, table, func);
+	} else {
+		/* method is already cached */
+		func = e->value;
 	}
 	return func;
 }