Changeset 4462


Ignore:
Timestamp:
10/19/03 20:26:05 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4458 r4462  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defclass.lisp,v 1.26 2003-10-19 18:33:16 piso Exp $
     4;;; $Id: defclass.lisp,v 1.27 2003-10-19 20:26:05 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    753753
    754754(defmacro defmethod (&rest args)
    755   (multiple-value-bind (function-name qualifiers lambda-list specializers
    756                                       body)
     755  (multiple-value-bind (function-name qualifiers lambda-list specializers body)
    757756    (parse-defmethod args)
    758757    `(progn
     
    889888
    890889(defun ensure-method (gf &rest all-keys)
     890;;   (format t "ENSURE-METHOD ~S all-keys = ~S~%" (generic-function-name gf) all-keys)
     891;;   (format t "ENSURE-METHOD gf type = ~S~%" (generic-function-method-combination gf))
     892;;   (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"))))
    891902  (let ((new-method
    892903         (apply
    893           (if (eq (generic-function-method-class gf)
    894                   the-class-standard-method)
     904          (if (eq (generic-function-method-class gf) the-class-standard-method)
    895905              #'make-instance-standard-method
    896906              #'make-instance)
     
    10671077
    10681078(defun primary-method-p (method)
    1069   (null (method-qualifiers method)))
     1079  (null (intersection '(:before :after :around) (method-qualifiers method))))
     1080
    10701081(defun before-method-p (method)
    10711082  (equal '(:before) (method-qualifiers method)))
     1083
    10721084(defun after-method-p (method)
    10731085  (equal '(:after) (method-qualifiers method)))
     1086
    10741087(defun around-method-p (method)
    10751088  (equal '(:around) (method-qualifiers method)))
Note: See TracChangeset for help on using the changeset viewer.