Changeset 4471


Ignore:
Timestamp:
10/20/03 15:33:11 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4470 r4471  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defclass.lisp,v 1.30 2003-10-20 15:03:31 piso Exp $
     4;;; $Id: defclass.lisp,v 1.31 2003-10-20 15:33:11 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    531531    :initarg :method-class)
    532532;;    (discriminating-function)  ; :accessor generic-function-discriminating-function
    533    (method-combination
     533   (method-combination-type
    534534    :initarg :method-combination)
    535535   (classes-to-emf-table      ; :accessor classes-to-emf-table
     
    565565  (setf (slot-value gf 'method-class) new-value))
    566566
    567 (defun generic-function-method-combination (gf)
    568   (slot-value gf 'method-combination))
    569 (defun (setf generic-function-method-combination) (new-value gf)
    570   (setf (slot-value gf 'method-combination) new-value))
     567(defun generic-function-method-combination-type (gf)
     568  (slot-value gf 'method-combination-type))
     569(defun (setf generic-function-method-combination-type) (new-value gf)
     570  (setf (slot-value gf 'method-combination-type) new-value))
    571571
    572572;;; Internal accessor for effective method function table
     
    732732    (setf (generic-function-methods gf) ())
    733733    (setf (generic-function-method-class gf) method-class)
    734     (setf (generic-function-method-combination gf) method-combination)
     734    (setf (generic-function-method-combination-type gf) method-combination)
    735735    (setf (classes-to-emf-table gf) (make-hash-table :test #'equal))
    736736    (finalize-generic-function gf)
     
    10911091;;   (let ((primaries (remove-if-not #'primary-method-p methods))
    10921092;;         (around (find-if #'around-method-p methods)))
    1093   (let ((primaries ())
     1093  (let ((type (generic-function-method-combination-type gf))
     1094        (primaries ())
    10941095        (arounds ())
    10951096        around)
    10961097    (dolist (m methods)
    1097       (cond ((around-method-p m)
    1098              (push m arounds))
    1099             ((primary-method-p m)
    1100              (push m primaries))))
     1098;;       (cond ((around-method-p m)
     1099;;              (push m arounds))
     1100;;             ((primary-method-p m)
     1101;;              (push m primaries))))
     1102      (let ((qualifiers (method-qualifiers m)))
     1103        (cond ((null qualifiers)
     1104               (if (eq type 'standard)
     1105                   (push m primaries)
     1106                   (error "method combination type mismatch")))
     1107              ((cdr qualifiers)
     1108               (error "invalid method qualifiers"))
     1109              ((eq (car qualifiers) :around)
     1110               (push m arounds))
     1111              ((eq (car qualifiers) type)
     1112               (push m primaries))
     1113              ((memq (car qualifiers) '(:before :after)))
     1114              (t
     1115               (invalid generic-function combin m)))))
    11011116    (setq primaries (nreverse primaries))
    11021117    (setq arounds (nreverse arounds))
     
    11131128          #'(lambda (args)
    11141129             (funcall (method-function around) args next-emfun)))
    1115         (case (generic-function-method-combination gf)
     1130        (case (generic-function-method-combination-type gf)
    11161131          (STANDARD
    11171132           (let ((next-emfun (compute-primary-emfun (cdr primaries)))
     
    11431158          (t
    11441159           (error "unsupported method combination type ~S~"
    1145                   (generic-function-method-combination gf)))))))
     1160                  (generic-function-method-combination-type gf)))))))
    11461161
    11471162;;; compute an effective method function from a list of primary methods:
Note: See TracChangeset for help on using the changeset viewer.