Changeset 4470


Ignore:
Timestamp:
10/20/03 15:03:31 (19 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4468 r4470  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defclass.lisp,v 1.29 2003-10-20 14:12:26 piso Exp $
     4;;; $Id: defclass.lisp,v 1.30 2003-10-20 15:03:31 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    891891;;   (format t "ENSURE-METHOD gf type = ~S~%" (generic-function-method-combination gf))
    892892;;   (format t "ENSURE-METHOD qualifiers = ~S~%" (getf all-keys :qualifiers))
    893   (let ((gf-method-combination-type (generic-function-method-combination gf))
    894         (qualifiers (getf all-keys :qualifiers)))
    895     (if (eq gf-method-combination-type 'standard)
    896         (unless (or (null qualifiers)
    897                     (and (= (length qualifiers) 1)
    898                          (memq (car qualifiers) '(:before :after :around))))
    899           (error "method combination type mismatch"))
    900         (unless (memq gf-method-combination-type qualifiers)
    901           (error "method combination type mismatch"))))
     893;;   (let ((gf-method-combination-type (generic-function-method-combination gf))
     894;;         (qualifiers (getf all-keys :qualifiers)))
     895;;     (if (eq gf-method-combination-type 'standard)
     896;;         (unless (or (null qualifiers)
     897;;                     (and (= (length qualifiers) 1)
     898;;                          (memq (car qualifiers) '(:before :after :around))))
     899;;           (error "method combination type mismatch"))
     900;;         (unless (memq gf-method-combination-type qualifiers)
     901;;           (error "method combination type mismatch"))))
    902902  (let ((new-method
    903903         (apply
     
    10891089
    10901090(defun std-compute-effective-method-function (gf methods)
    1091   (let ((primaries (remove-if-not #'primary-method-p methods))
    1092         (around (find-if #'around-method-p methods)))
     1091;;   (let ((primaries (remove-if-not #'primary-method-p methods))
     1092;;         (around (find-if #'around-method-p methods)))
     1093  (let ((primaries ())
     1094        (arounds ())
     1095        around)
     1096    (dolist (m methods)
     1097      (cond ((around-method-p m)
     1098             (push m arounds))
     1099            ((primary-method-p m)
     1100             (push m primaries))))
     1101    (setq primaries (nreverse primaries))
     1102    (setq arounds (nreverse arounds))
     1103    (setq around (car arounds))
    10931104    (when (null primaries)
    10941105      (error "no primary methods for the generic function ~S" gf))
Note: See TracChangeset for help on using the changeset viewer.