Changeset 13726 for trunk/abcl/src/org/armedbear/lisp/clos.lisp
- Timestamp:
- 01/06/12 22:45:48 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13725 r13726 827 827 ,@(canonicalize-defclass-options options))) 828 828 829 (defstruct method-combination830 name831 documentation)832 833 (defstruct (short-method-combination834 (:include method-combination))835 operator836 identity-with-one-argument)837 838 (defstruct (long-method-combination839 (:include method-combination))840 lambda-list841 method-group-specs842 args-lambda-list843 generic-function-symbol844 function845 arguments846 declarations847 forms)848 849 829 (defun expand-long-defcombin (name args) 850 830 (destructuring-bind (lambda-list method-groups &rest body) args … … 854 834 (list ,@(mapcar #'canonicalize-method-group-spec method-groups)) 855 835 ',body))) 836 837 ;;; The class method-combination and its subclasses are defined in 838 ;;; StandardClass.java, but we cannot use make-instance and slot-value 839 ;;; yet. 840 (defun make-short-method-combination (&key name documentation operator identity-with-one-argument) 841 (let ((instance (std-allocate-instance (find-class 'short-method-combination)))) 842 (when name (setf (std-slot-value instance 'sys::name) name)) 843 (when documentation 844 (setf (std-slot-value instance 'documentation) documentation)) 845 (when operator (setf (std-slot-value instance 'operator) operator)) 846 (when identity-with-one-argument 847 (setf (std-slot-value instance 'identity-with-one-argument) 848 identity-with-one-argument)) 849 instance)) 850 851 (defun make-long-method-combination (&key name documentation lambda-list 852 method-group-specs args-lambda-list 853 generic-function-symbol function 854 arguments declarations forms) 855 (let ((instance (std-allocate-instance (find-class 'long-method-combination)))) 856 (when name (setf (std-slot-value instance 'sys::name) name)) 857 (when documentation 858 (setf (std-slot-value instance 'documentation) documentation)) 859 (when lambda-list 860 (setf (std-slot-value instance 'sys::lambda-list) lambda-list)) 861 (when method-group-specs 862 (setf (std-slot-value instance 'method-group-specs) method-group-specs)) 863 (when args-lambda-list 864 (setf (std-slot-value instance 'args-lambda-list) args-lambda-list)) 865 (when generic-function-symbol 866 (setf (std-slot-value instance 'generic-function-symbol) 867 generic-function-symbol)) 868 (when function 869 (setf (std-slot-value instance 'function) function)) 870 (when arguments 871 (setf (std-slot-value instance 'arguments) arguments)) 872 (when declarations 873 (setf (std-slot-value instance 'declarations) declarations)) 874 (when forms 875 (setf (std-slot-value instance 'forms) forms)) 876 instance)) 877 878 (defun method-combination-name (method-combination) 879 (check-type method-combination method-combination) 880 (std-slot-value method-combination 'sys::name)) 881 882 (defun method-combination-documentation (method-combination) 883 (check-type method-combination method-combination) 884 (std-slot-value method-combination 'documentation)) 885 886 (defun short-method-combination-operator (method-combination) 887 (check-type method-combination short-method-combination) 888 (std-slot-value method-combination 'operator)) 889 890 (defun short-method-combination-identity-with-one-argument (method-combination) 891 (check-type method-combination short-method-combination) 892 (std-slot-value method-combination 'identity-with-one-argument)) 893 894 (defun long-method-combination-lambda-list (method-combination) 895 (check-type method-combination long-method-combination) 896 (std-slot-value method-combination 'sys::lambda-list)) 897 898 (defun long-method-combination-method-group-specs (method-combination) 899 (check-type method-combination long-method-combination) 900 (std-slot-value method-combination 'method-group-specs)) 901 902 (defun long-method-combination-args-lambda-list (method-combination) 903 (check-type method-combination long-method-combination) 904 (std-slot-value method-combination 'args-lambda-list)) 905 906 (defun long-method-combination-generic-function-symbol (method-combination) 907 (check-type method-combination long-method-combination) 908 (std-slot-value method-combination 'generic-function-symbol)) 909 910 (defun long-method-combination-function (method-combination) 911 (check-type method-combination long-method-combination) 912 (std-slot-value method-combination 'function)) 913 914 (defun long-method-combination-arguments (method-combination) 915 (check-type method-combination long-method-combination) 916 (std-slot-value method-combination 'arguments)) 917 918 (defun long-method-combination-declarations (method-combination) 919 (check-type method-combination long-method-combination) 920 (std-slot-value method-combination 'declarations)) 921 922 (defun long-method-combination-forms (method-combination) 923 (check-type method-combination long-method-combination) 924 (std-slot-value method-combination 'forms)) 925 856 926 857 927 (defun expand-short-defcombin (whole)
Note: See TracChangeset
for help on using the changeset viewer.