Changeset 5882


Ignore:
Timestamp:
02/19/04 19:12:02 (17 years ago)
Author:
piso
Message:

Work in progress: STD-COMPUTE-EFFECTIVE-METHOD-FUNCTION.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/clos.lisp

    r5881 r5882  
    22;;;
    33;;; Copyright (C) 2003-2004 Peter Graves
    4 ;;; $Id: clos.lisp,v 1.90 2004-02-19 18:29:42 piso Exp $
     4;;; $Id: clos.lisp,v 1.91 2004-02-19 19:12:02 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    14271427                (funcall (method-function around) args next-emfun))))
    14281428          ((eq mc-name 'standard)
    1429            (let ((next-emfun (compute-primary-emfun (cdr primaries)))
    1430                  (befores (remove-if-not #'before-method-p methods))
    1431                  (reverse-afters
    1432                   (reverse (remove-if-not #'after-method-p methods))))
    1433              #'(lambda (args)
    1434                 (dolist (before befores)
    1435                   (funcall (method-function before) args nil))
    1436                 (multiple-value-prog1
    1437                  (funcall (method-function (car primaries)) args next-emfun)
    1438                  (dolist (after reverse-afters)
    1439                    (funcall (method-function after) args nil))))))
     1429           (let* ((next-emfun (compute-primary-emfun (cdr primaries)))
     1430                  (befores (remove-if-not #'before-method-p methods))
     1431                  (reverse-afters
     1432                   (reverse (remove-if-not #'after-method-p methods)))
     1433                  (code
     1434                   (make-closure
     1435                    (if (and (null befores) (null reverse-afters))
     1436                        `(lambda (args)
     1437                           (funcall (method-function ,(car primaries)) args ,next-emfun))
     1438                        `(lambda (args)
     1439                           (dolist (before ',befores)
     1440                             (funcall (method-function before) args nil))
     1441                           (multiple-value-prog1
     1442                            (funcall (method-function ,(car primaries)) args ,next-emfun)
     1443                            (dolist (after ',reverse-afters)
     1444                              (funcall (method-function after) args nil)))))
     1445                    nil)))
     1446             code))
    14401447          (t
    14411448           (let ((mc-obj (get mc-name 'method-combination-object)))
Note: See TracChangeset for help on using the changeset viewer.