Improve setf slot_accesor

sasagawa888 · Oct 9, 2024 · 9cac18e · 9cac18e
1 parent d464dee
commit 9cac18e
Show file tree

Hide file tree

Showing 2 changed files with 21 additions and 13 deletions.
diff --git a/data.c b/data.c
@@ -685,12 +685,17 @@ int has_multiple_call_next_method_p2(int x)
 	return (0);
 }
 
+/*  if function is writer or accesor generic function.
+*   slot gunctions have property,
+*   1=reader, 2=writer, 3=accesor 4=boundp
+*/
+
 int slot_accesor_p(int x)
 {
     int prop;
 
-    prop = assoc(make_sym("SLOT"), GET_PROP(x));
-    if (numberp(cdr(prop)))
+    prop = cdr(assoc(make_sym("SLOT"), GET_PROP(x)));
+    if (integerp(prop) && (get_int(prop) == 2 || get_int(prop) == 3))
 	return (1);
     else
 	return (0);

diff --git a/syntax.c b/syntax.c
@@ -1790,6 +1790,13 @@ int f_defgeneric(int arglist, int th)
     arg1 = car(arglist);	/* func-name */
     arg2 = cadr(arglist);	/* lambda-list */
     arg3 = cddr(arglist);	/*  body */
+
+	/* when (defgeneric (setf foo) ...) */
+    if (listp(arg1) && car(arg1) == make_sym("SETF")) {
+	setf_list = cons(cadr(arg1), setf_list);
+	arg1 = cadr(arg1);
+    }
+
     if (symbolp(arg1) && GET_OPT(arg1) == CONSTN) {
 	error(CANT_MODIFY, "defgeneric", arg1, th);
     }
@@ -1824,12 +1831,7 @@ int f_defgeneric(int arglist, int th)
     if (!top_flag && !ignore_topchk) {
 	error(NOT_TOP_LEVEL, "defgeneric", arglist, th);
     }
-    /* when (defgeneric (setf foo) ...) */
-    if (listp(arg1) && car(arg1) == make_sym("SETF")) {
-	setf_list = cons(cadr(arg1), setf_list);
-	arg1 = cadr(arg1);
-    }
-
+
     if (!member(arg1, generic_list))
 	generic_list = cons(arg1, generic_list);
 
@@ -1874,6 +1876,11 @@ int f_defmethod(int arglist, int th)
     arg1 = car(arglist);	/* method-name */
     arg2 = cdr(arglist);	/* parameter-profile */
 
+	/* when (defmethod (setf foo) ...) */
+    if (listp(arg1) && car(arg1) == make_sym("SETF")) {
+	arg1 = cadr(arg1);
+    }
+
     if (symbolp(arg1) && (subrp(arg1) || fsubrp(arg1))) {
 	error(CANT_MODIFY, "defmethod", arg1, th);
     }
@@ -1890,11 +1897,7 @@ int f_defmethod(int arglist, int th)
 		 && symbolp(cadr(arg1))))) {
 	error(ILLEGAL_FORM, "defmethod", arg1, th);
     }
-    /* when (defmethod (setf foo) ...) */
-    if (listp(arg1) && car(arg1) == make_sym("SETF")) {
-	arg1 = cadr(arg1);
-    }
-
+
     if (listp(car(arg2)) && illegal_lambda_p(car(arg2))) {
 	error(ILLEGAL_ARGS, "defmethod", arg2, th);
     }