Changeset 5232
 Timestamp:
 12/20/03 18:12:01 (17 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/j/src/org/armedbear/lisp/clos.lisp
r5229 r5232 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: clos.lisp,v 1.5 1 20031220 16:26:27piso Exp $4 ;;; $Id: clos.lisp,v 1.52 20031220 18:12:01 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 1063 1063 (setf (methodenvironment method) environment) 1064 1064 (setf (methodgenericfunction method) nil) 1065 (setf (methodfunction method) 1066 (stdcomputemethodfunction method)) 1065 (setf (methodfunction method) (stdcomputemethodfunction method)) 1067 1066 method)) 1068 1067 … … 1171 1170 (setf (gethash classes (classestoemftable gf)) emfun) 1172 1171 (funcall emfun args)) 1173 (error "no applicable methods for generic function ~S with arguments ~S of classes ~S" gf args classes)))) 1172 (error "No applicable methods for generic function ~S with arguments ~S of classes ~S." 1173 gf args classes)))) 1174 1174 1175 1175 (defun computeapplicablemethodsusingclasses (gf requiredclasses) … … 1351 1351 (methodgenericfunction method) nextmethods)))) 1352 1352 1353 (defvar *callnextmethodp*) 1354 (defvar *nextmethodpp*) 1355 1356 (defun walkform (form) 1357 (cond ((atom form) 1358 (cond ((eq form 'callnextmethod) 1359 (setf *callnextmethodp* t)) 1360 ((eq form 'nextmethodp) 1361 (setf *nextmethodpp* t)))) 1362 (t 1363 (walkform (car form)) 1364 (walkform (cdr form))))) 1365 1353 1366 (defun stdcomputemethodfunction (method) 1354 1367 (let ((form (methodbody method)) 1355 (lambdalist (methodlambdalist method))) 1368 (lambdalist (methodlambdalist method)) 1369 (*callnextmethodp* nil) 1370 (*nextmethodpp* nil)) 1371 (walkform form) 1356 1372 (compileinlexicalenvironment 1357 1373 (methodenvironment method) 1358 `(lambda (args nextemfun) 1359 (flet ((callnextmethod (&rest cnmargs) 1360 (if (null nextemfun) 1361 (error "no next method for generic function ~S" 1362 (methodgenericfunction ',method)) 1363 (funcall nextemfun (or cnmargs args)))) 1364 (nextmethodp () 1365 (not (null nextemfun)))) 1366 (apply #'(lambda ,(kludgearglist lambdalist) 1367 ,form) 1368 args)))))) 1374 (if (or *callnextmethodp* *nextmethodpp*) 1375 `(lambda (args nextemfun) 1376 (flet ((callnextmethod (&rest cnmargs) 1377 (if (null nextemfun) 1378 (error "No next method for generic function ~S." 1379 (methodgenericfunction ',method)) 1380 (funcall nextemfun (or cnmargs args)))) 1381 (nextmethodp () 1382 (not (null nextemfun)))) 1383 (apply #'(lambda ,(kludgearglist lambdalist) 1384 ,form) 1385 args))) 1386 `(lambda (args nextemfun) 1387 (apply #'(lambda ,(kludgearglist lambdalist) 1388 ,form) 1389 args)))))) 1369 1390 1370 1391 ;;; N.B. The function kludgearglist is used to pave over the differences
Note: See TracChangeset
for help on using the changeset viewer.