/[cmucl]/src/pcl/combin.lisp
ViewVC logotype

Diff of /src/pcl/combin.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13.2.1 by gerd, Sun Mar 9 12:47:20 2003 UTC revision 1.26 by rtoy, Fri Mar 19 15:19:03 2010 UTC
# Line 24  Line 24 
24  ;;; Suggestions, comments and requests for improvements are also welcome.  ;;; Suggestions, comments and requests for improvements are also welcome.
25  ;;; *************************************************************************  ;;; *************************************************************************
26    
27  (ext:file-comment  (file-comment
28    "$Header$")    "$Header$")
29    
30  (in-package "PCL")  (in-package "PCL")
31    (intl:textdomain "cmucl")
32    
33  ;;;  ;;;
34  ;;; In the following:  ;;; In the following:
# Line 83  Line 84 
84    (standard-compute-effective-method gf combin applicable-methods))    (standard-compute-effective-method gf combin applicable-methods))
85    
86  (defun standard-compute-effective-method (gf combin applicable-methods)  (defun standard-compute-effective-method (gf combin applicable-methods)
87    (declare (ignore combin))    (collect ((before) (primary) (after) (around) (invalid))
88    (let ((before ())      (labels ((lose (method why)
89          (primary ())                 (invalid-method-error
90          (after ())                  method
91          (around ()))                  "~@<The method ~S ~A.  ~
92      (flet ((lose (method why)                   Standard method combination requires all methods to have ~
93               (invalid-method-error                   one of the single qualifiers ~s, ~s and ~s or to have ~
94                method                   no qualifier at all.~@:>"
95                "~@<The method ~S ~A.  ~                  method why :around :before :after))
96                 Standard method combination requires all methods to have one ~               (invalid-method (method why)
97                 of the single qualifiers ~s, ~s and ~s or to have no qualifier ~                 (declare (special *in-precompute-effective-methods-p*))
98                 at all.~@:>"                 (if *in-precompute-effective-methods-p*
99                method why :around :before :after)))                     (invalid method)
100                       (lose method why))))
101        (dolist (m applicable-methods)        (dolist (m applicable-methods)
102          (let ((qualifiers (if (listp m)          (let ((qualifiers (if (listp m)
103                                (early-method-qualifiers m)                                (early-method-qualifiers m)
104                                (method-qualifiers m))))                                (method-qualifiers m))))
105            (cond ((null qualifiers)            (cond ((null qualifiers)
106                   (push m primary))                   (primary m))
107                  ((cdr qualifiers)                  ((cdr qualifiers)
108                   (lose m "has more than one qualifier"))                   (invalid-method m _"has more than one qualifier"))
109                  ((eq (car qualifiers) :around)                  ((eq (car qualifiers) :around)
110                   (push m around))                   (around m))
111                  ((eq (car qualifiers) :before)                  ((eq (car qualifiers) :before)
112                   (push m before))                   (before m))
113                  ((eq (car qualifiers) :after)                  ((eq (car qualifiers) :after)
114                   (push m after))                   (after m))
115                  (t                  (t
116                   (lose m "has an illegal qualifier"))))))                   (invalid-method m _"has an invalid qualifier")))))
117      (setq before  (reverse before)        (cond ((invalid)
118            after   (reverse after)               `(%invalid-qualifiers ',gf ',combin .args. ',(invalid)))
119            primary (reverse primary)              ((null (primary))
120            around  (reverse around))               `(%no-primary-method ',gf .args.))
121      (cond ((null primary)              ((and (null (before)) (null (after)) (null (around)))
122             `(%no-primary-method ',gf .args.))               ;;
123            ((and (null before) (null after) (null around))               ;; By returning a single CALL-METHOD form here, we enable
124             ;;               ;; an important implementation-specific optimization, which
125             ;; By returning a single CALL-METHOD form here, we enable an               ;; uses fast-method functions directly for effective method
126             ;; important implementation-specific optimization.               ;; functions.  (Which is also the reason emfs have a
127             `(call-method ,(first primary) ,(rest primary)))               ;; lambda-list like fast method functionts.)
128            (t               ;;
129             (let ((main-effective-method               ;; This cannot be done if the gf requires keyword argument
130                     (if (or before after)               ;; checking as in CLHS 7.6.5 because we can't tell in
131                         `(multiple-value-prog1               ;; method functions if they are used as emfs only.  If they
132                            (progn               ;; are not used as emfs only, they should accept any keyword
133                              ,(make-call-methods before)               ;; arguments, per CLHS 7.6.4, for instance.
134                              (call-method ,(first primary) ,(rest primary)))               (let ((call-method `(call-method ,(first (primary))
135                            ,(make-call-methods (reverse after)))                                                ,(rest (primary)))))
136                         `(call-method ,(first primary) ,(rest primary)))))                 (if (emfs-must-check-applicable-keywords-p gf)
137               (if around                     `(progn ,call-method)
138                   `(call-method ,(first around)                     call-method)))
139                                 (,@(rest around)              (t
140                                    (make-method ,main-effective-method)))               (let ((main-effective-method
141                   main-effective-method))))))                      (if (or (before) (after))
142                            `(multiple-value-prog1
143                                 (progn
144                                   ,(make-call-methods (before))
145                                   (call-method ,(first (primary)) ,(rest (primary))))
146                               ,(make-call-methods (reverse (after))))
147                            `(call-method ,(first (primary)) ,(rest (primary))))))
148                   (if (around)
149                       `(call-method ,(first (around))
150                                     (,@(rest (around))
151                                        (make-method ,main-effective-method)))
152                       main-effective-method)))))))
153    
154  (defvar *invalid-method-error*  (defvar *invalid-method-error*
155          (lambda (&rest args)          (lambda (&rest args)
156            (declare (ignore args))            (declare (ignore args))
157            (error            (error
158             "~@<~s was called outside the dynamic scope ~             _"~@<~s was called outside the dynamic scope ~
159              of a method combination function (inside the body of ~              of a method combination function (inside the body of ~
160              ~s or a method on the generic function ~s).~@:>"              ~s or a method on the generic function ~s).~@:>"
161             'invalid-method-error 'define-method-combination             'invalid-method-error 'define-method-combination
# Line 152  Line 165 
165          (lambda (&rest args)          (lambda (&rest args)
166            (declare (ignore args))            (declare (ignore args))
167            (error            (error
168             "~@<~s was called outside the dynamic scope ~             _"~@<~s was called outside the dynamic scope ~
169              of a method combination function (inside the body of ~              of a method combination function (inside the body of ~
170              ~s or a method on the generic function ~s).~@:>"              ~s or a method on the generic function ~s).~@:>"
171             'method-combination-error 'define-method-combination             'method-combination-error 'define-method-combination
# Line 166  Line 179 
179    
180  (defmacro call-method (&rest args)  (defmacro call-method (&rest args)
181    (declare (ignore args))    (declare (ignore args))
182    `(error "~@<~S used outsize of a effective method form.~@:>" 'call-method))    ;;
183      ;; Hack: The PROGN is here so that RESTART-CASE doesn't see the
184      ;; ERROR.  See MUNGE-RESTART-CASE-EXPRESSION in code:error.lisp.
185      `(progn (error _"~@<~S used outside of a effective method form.~@:>" 'call-method)))
186    
187  (defmacro call-method-list (&rest calls)  (defmacro call-method-list (&rest calls)
188    `(progn ,@calls))    `(progn ,@calls))
# Line 273  Line 289 
289    
290  ;;;  ;;;
291  ;;; Return a closure returning a FAST-METHOD-CALL instance for the  ;;; Return a closure returning a FAST-METHOD-CALL instance for the
292  ;;; call of the effective method of generic function GF with body  ;;; call of an effective method of generic function GF with body
293  ;;; BODY.  ;;; BODY.
294  ;;;  ;;;
295  (defun callable-generator-for-emf (gf body method-alist-p wrappers-p)  (defun callable-generator-for-emf (gf body method-alist-p wrappers-p)
296    (multiple-value-bind (nreq applyp metatypes nkeys arg-info)    (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
297        (get-generic-function-info gf)        (get-generic-function-info gf)
298      (declare (ignore nkeys arg-info))      (declare (ignore nkeys arg-info))
299      (let* ((name (if (early-gf-p gf)      (let* ((name (generic-function-name* gf))
300                       (early-gf-name gf)             (fmc-info (cons nreq applyp))
                      (generic-function-name gf)))  
            (arg-info (cons nreq applyp))  
301             (effective-method-lambda (make-effective-method-lambda gf body)))             (effective-method-lambda (make-effective-method-lambda gf body)))
302        (multiple-value-bind (cfunction constants)        (multiple-value-bind (cfunction constants)
303            (get-function1 effective-method-lambda            (get-function1 effective-method-lambda
# Line 296  Line 310 
310                           (lambda (form)                           (lambda (form)
311                             (memf-constant-converter form gf)))                             (memf-constant-converter form gf)))
312          (lambda (method-alist wrappers)          (lambda (method-alist wrappers)
313            (let* ((constants            (declare (special *applicable-methods*))
314                    (mapcar (lambda (constant)            (multiple-value-bind (valid-keys keyargs-start)
315                              (case (car-safe constant)                (when (memq '.valid-keys. constants)
316                                (.meth.                  (compute-applicable-keywords gf *applicable-methods*))
317                                 (funcall (cdr constant) method-alist wrappers))              (flet ((compute-constant (constant)
318                                (.meth-list.                       (if (consp constant)
319                                 (mapcar (lambda (fn)                           (case (car constant)
320                                           (funcall fn method-alist wrappers))                             (.meth.
321                                         (cdr constant)))                              (funcall (cdr constant) method-alist wrappers))
322                                (t constant)))                             (.meth-list.
323                            constants))                              (mapcar (lambda (fn)
324                   (function (set-function-name (apply cfunction constants)                                        (funcall fn method-alist wrappers))
325                                                `(effective-method ,name))))                                      (cdr constant)))
326              (make-fast-method-call :function function                             (t constant))
327                                     :arg-info arg-info)))))))                           (case constant
328                               (.keyargs-start. keyargs-start)
329                               (.valid-keys. valid-keys)
330                               (t constant)))))
331                  (let ((fn (apply cfunction
332                                   (mapcar #'compute-constant constants))))
333                    (set-function-name fn `(effective-method ,name))
334                    (make-fast-method-call :function fn :arg-info fmc-info)))))))))
335    
336    ;;;
337    ;;; Return true if emfs of generic function GF must do keyword
338    ;;; argument checking with CHECK-APPLICABLE-KEYWORDS.
339    ;;;
340    ;;; We currently do this if the generic function type has &KEY, which
341    ;;; should be the case if the gf or any method has &KEY.  It would be
342    ;;; possible to avoid the check if it also has &ALLOW-OTHER-KEYS, iff
343    ;;; method functions do checks of their own, which is ugly to do,
344    ;;; so we don't.
345    ;;;
346    (defun emfs-must-check-applicable-keywords-p (gf)
347      (let ((type (info function type (generic-function-name* gf))))
348        (and (kernel::function-type-p type)
349             (kernel::function-type-keyp type))))
350    
351    ;;;
352    ;;; Compute which keyword args are valid in a call of generic function
353    ;;; GF with applicable methods METHODS.  See also CLHS 7.6.5.
354    ;;;
355    ;;; First value is either a list of valid keywords or T meaning all
356    ;;; keys are valid.  Second value is the number of optional arguments
357    ;;; that GF takes.  This number is used as an offset in the supplied
358    ;;; args .DFUN-REST-ARG. in CHECK-APPLICABLE-KEYWORDS.
359    ;;;
360    (defun compute-applicable-keywords (gf methods)
361      (let ((any-keyp nil))
362        (flet ((analyze (lambda-list)
363                 (multiple-value-bind (nreq nopt keyp restp allowp keys)
364                     (analyze-lambda-list lambda-list)
365                   (declare (ignore nreq restp))
366                   (when keyp
367                     (setq any-keyp t))
368                   (values nopt allowp keys))))
369          (multiple-value-bind (nopt allowp keys)
370              (analyze (generic-function-lambda-list gf))
371            (if allowp
372                (setq keys t)
373                (dolist (method methods)
374                  (multiple-value-bind (n allowp method-keys)
375                      (analyze (method-lambda-list* method))
376                    (declare (ignore n))
377                    (if allowp
378                        (return (setq keys t))
379                        (setq keys (union method-keys keys))))))
380            ;;
381            ;; It shouldn't happen thet neither the gf nor any method has
382            ;; &KEY, when this method is called.  Let's handle the case
383            ;; anyway, just for generality.
384            (values (if any-keyp keys t) nopt)))))
385    
386    ;;;
387    ;;; Check ARGS for invalid keyword arguments, beginning at position
388    ;;; START in ARGS.  VALID-KEYS is a list of valid keywords.  VALID-KEYS
389    ;;; being T means all keys are valid.
390    ;;;
391    (defun check-applicable-keywords (args start valid-keys)
392      (let ((allow-other-keys-seen nil)
393            (allow-other-keys nil)
394            (args (nthcdr start args)))
395        (collect ((invalid))
396          (loop
397             (when (null args)
398               (when (and (invalid) (not allow-other-keys))
399                 (simple-program-error
400                  _"~@<Invalid keyword argument~p ~{~s~^, ~}.  ~
401                   Valid keywords are: ~{~s~^, ~}.~@:>"
402                  (length (invalid))
403                  (invalid)
404                  valid-keys))
405               (return))
406             (let ((key (pop args)))
407               (cond ((not (symbolp key))
408                      (invalid-keyword-argument key))
409                     ((null args)
410                      (odd-number-of-keyword-arguments))
411                     ((eq key :allow-other-keys)
412                      (unless allow-other-keys-seen
413                        (setq allow-other-keys-seen t
414                              allow-other-keys (car args))))
415                     ((eq t valid-keys))
416                     ((not (memq key valid-keys))
417                      (invalid key))))
418             (pop args)))))
419    
420    (defun odd-number-of-keyword-arguments ()
421      (simple-program-error _"Odd number of keyword arguments."))
422    
423    (defun invalid-keyword-argument (key)
424      (simple-program-error _"Invalid keyword argument ~s" key))
425    
426  ;;;  ;;;
427  ;;; Return a lambda-form for an effective method of generic function  ;;; Return a lambda-form for an effective method of generic function
# Line 320  Line 431 
431    (multiple-value-bind (nreq applyp metatypes nkeys arg-info)    (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
432        (get-generic-function-info gf)        (get-generic-function-info gf)
433      (declare (ignore nreq nkeys arg-info))      (declare (ignore nreq nkeys arg-info))
434        ;;
435        ;; Note that emfs use the same lambda-lists as fast method
436        ;; functions, although they don't need all the arguments that a
437        ;; fast method function needs, because this makes it possible to
438        ;; use fast method functions directly as emfs.  This is achieved
439        ;; by returning a single CALL-METHOD form from the method
440        ;; combination.
441      (let ((ll (make-fast-method-call-lambda-list metatypes applyp))      (let ((ll (make-fast-method-call-lambda-list metatypes applyp))
442            (error-p (eq (first body) '%no-primary-method))            (check-applicable-keywords
443               (when (and applyp (emfs-must-check-applicable-keywords-p gf))
444                 '((check-applicable-keywords))))
445              (error-p
446               (memq (first body) '(%no-primary-method %invalid-qualifiers)))
447            (mc-args-p            (mc-args-p
448             (when (eq *boot-state* 'complete)             (when (eq *boot-state* 'complete)
449               ;; Otherwise the METHOD-COMBINATION slot is not bound.               ;; Otherwise the METHOD-COMBINATION slot is not bound.
# Line 341  Line 463 
463                    (declare (ignore .pv-cell. .next-method-call.))                    (declare (ignore .pv-cell. .next-method-call.))
464                    (let ((.gf-args. ,gf-args))                    (let ((.gf-args. ,gf-args))
465                      (declare (ignorable .gf-args.))                      (declare (ignorable .gf-args.))
466                        ,@check-applicable-keywords
467                      ,body))))                      ,body))))
468              (t              (t
469               `(lambda ,ll               `(lambda ,ll
470                  (declare (ignore .pv-cell. .next-method-call.))                  (declare (ignore .pv-cell. .next-method-call.))
471                    ,@check-applicable-keywords
472                  ,body))))))                  ,body))))))
473    
474    ;;;
475    ;;; Return true if a fast-method-call to METHOD can be inlined.
476    ;;;
477    ;;; We don't generate funcalls for standard accessor methods because
478    ;;; they have a fast function, but that's not what is actually to be
479    ;;; called.  What is called is a closure over MAKE-STD-*-METHOD-FUNCTION.
480    ;;;
481    (defun inlinable-method-p (method)
482      (and (eq *boot-state* 'complete)
483           *inline-methods-in-emfs*
484           (not (standard-accessor-method-p method))))
485    
486    ;;;
487    ;;; Return a form for calling METHOD's fast function.  METATYPES is a
488    ;;; list of metatypes, whose length is used to figure out the names of
489    ;;; required emf parameters.  REST? true means the method has a &rest
490    ;;; arg.  CALLABLE-VAR is the name of a closed-over variable
491    ;;; containing a FAST-METHOD-CALL instance corresponding to the
492    ;;; method invocation.
493    ;;;
494    (defun make-direct-call (method metatypes rest? callable-var)
495      (let* ((fn-name (method-function-name method))
496             (fn `(the function #',fn-name))
497             (cell `(fast-method-call-pv-cell ,callable-var))
498             (next `(fast-method-call-next-method-call ,callable-var))
499             (req (dfun-arg-symbol-list metatypes)))
500        (assert (fboundp fn-name))
501        `(funcall ,fn ,cell ,next ,@req ,@(when rest? `(.dfun-rest-arg.)))))
502    
503    ;;;
504    ;;; Return the list of methods from a CALL-METHOD-LIST form.
505    ;;;
506    (defun call-method-list-methods (call-method-list)
507      (loop for call-method-form in (cdr call-method-list)
508            collect (second call-method-form)))
509    
510    ;;;
511    ;;; Compute a key from FORM.  This function is called via the
512    ;;; GET-FUNCTION mechanism on forms of an emf lambda.  Values returned
513    ;;; that are not EQ to FORM are considered keys.  All keys are
514    ;;; collected and serve GET-FUNCTION as a key in its table of already
515    ;;; computed functions.  That is, if two emf lambdas produce the same
516    ;;; key, a previously compiled function can be used.
517    ;;;
518  (defun memf-test-converter (form gf method-alist-p wrappers-p)  (defun memf-test-converter (form gf method-alist-p wrappers-p)
519    (case (car-safe form)    (flet ((method-key (method)
520      (call-method             (cond ((inlinable-method-p method)
521       (case (get-method-call-type gf form method-alist-p wrappers-p)                    (method-function-name method))
522         (fast-method-call '.fast-call-method.)                   ((eq (get-method-call-type gf form method-alist-p wrappers-p)
523         (t '.call-method.)))                        'fast-method-call)
524      (call-method-list                    '.fast-call-method.)
525       (case (get-method-list-call-type gf form method-alist-p wrappers-p)                   (t '.call-method.))))
526         (fast-method-call '.fast-call-method-list.)      (case (car-safe form)
527         (t '.call-method-list.)))        ;;
528      (t        (call-method
529       (default-test-converter form))))         (if (eq (get-method-call-type gf form method-alist-p wrappers-p)
530                   'fast-method-call)
531  (defun memf-code-converter (form gf metatypes applyp method-alist-p             (method-key (second form))
532               '.call-method.))
533          ;;
534          (call-method-list
535           (mapcar #'method-key (call-method-list-methods form)))
536          ;;
537          (check-applicable-keywords
538           'check-applicable-keywords)
539          (t
540           (default-test-converter form)))))
541    
542    ;;;
543    ;;; This function is called via the GET-FUNCTION mechanism on forms of
544    ;;; an emf lambda.  First value returned replaces FORM in the emf
545    ;;; lambda.  Second value is a list of variable names that become
546    ;;; closure variables.
547    ;;;
548    (defun memf-code-converter (form gf metatypes rest? method-alist-p
549                              wrappers-p)                              wrappers-p)
550    (case (car-safe form)    (labels ((make-call (call-type method metatypes rest? callable-var)
551      (call-method               (if (and (eq call-type 'fast-method-call)
552       (let ((gensym (gensym "MEMF")))                        (inlinable-method-p method))
553         (values (make-emf-call metatypes applyp gensym                   (make-direct-call method metatypes rest? callable-var)
554                                (get-method-call-type gf form method-alist-p                   (make-emf-call metatypes rest? callable-var call-type)))
555                                                      wrappers-p))  
556                 (list gensym))))             (make-calls (call-type methods metatypes rest? list-var)
557      (call-method-list               `(let ((.list. ,list-var))
558       (let ((gensym (gensym "MEMF"))                  (declare (ignorable .list.))
559             (type (get-method-list-call-type gf form method-alist-p                  ,@(loop for method in methods collect
560                                              wrappers-p)))                            `(let ((.call. (pop .list.)))
561         (values `(dolist (emf ,gensym nil)                               ,(make-call call-type method metatypes
562                    ,(make-emf-call metatypes applyp 'emf type))                                           rest? '.call.))))))
563                 (list gensym))))      (case (car-safe form)
564      (t        ;;
565       (default-code-converter form))))        ;; (CALL-METHOD <method-object> &optional <next-methods>)
566          (call-method
567           (let ((method (cadr form))
568                 (callable-var (gensym))
569                 (call-type (get-method-call-type gf form method-alist-p
570                                                  wrappers-p)))
571             (values (make-call call-type method metatypes rest? callable-var)
572                     (list callable-var))))
573          ;;
574          ;; (CALL-METHOD-LIST <call-method-form>*)
575          ;; where each CALL-METHOD form is (CALL-METHOD <method>)
576          (call-method-list
577           (let ((list-var (gensym))
578                 (call-type (get-method-list-call-type gf form method-alist-p
579                                                       wrappers-p))
580                 (methods (call-method-list-methods form)))
581             (values (make-calls call-type methods metatypes rest? list-var)
582                     (list list-var))))
583          ;;
584          (check-applicable-keywords
585           (values `(check-applicable-keywords .dfun-rest-arg.
586                                               .keyargs-start. .valid-keys.)
587                   '(.keyargs-start. .valid-keys.)))
588          (t
589           (default-code-converter form)))))
590    
591  (defun memf-constant-converter (form gf)  (defun memf-constant-converter (form gf)
592    (case (car-safe form)    (case (car-safe form)
# Line 389  Line 598 
598                   (mapcar (lambda (form)                   (mapcar (lambda (form)
599                             (callable-generator-for-call-method gf form))                             (callable-generator-for-call-method gf form))
600                           (cdr form)))))                           (cdr form)))))
601        (check-applicable-keywords
602         '(.keyargs-start. .valid-keys.))
603      (t      (t
604       (default-constant-converter form))))       (default-constant-converter form))))
605    
# Line 444  Line 655 
655  ;;; CALLABLE-GENERATOR.  Call it with two args METHOD-ALIST and  ;;; CALLABLE-GENERATOR.  Call it with two args METHOD-ALIST and
656  ;;; WRAPPERS to obtain the actual callable.  ;;; WRAPPERS to obtain the actual callable.
657  ;;;  ;;;
658  (defun make-callable (gf methods generator method-alist wrappers)  (defvar *applicable-methods*)
   (let ((callable (function-funcall generator method-alist wrappers)))  
     (set-emf-name gf methods callable)))  
659    
660  ;;;  (defun make-callable (gf methods generator method-alist wrappers)
661  ;;; When *NAME-EMFS-P* is true, give the effective method represented    (let* ((*applicable-methods* methods)
662  ;;; by CALLABLE a suitable global name of the form (EFFECTIVE-METHOD           (callable (function-funcall generator method-alist wrappers)))
663  ;;; ...).  GF is the generic function the effective method is for, and      (when *named-emfs-p*
664  ;;; METHODS is the list of applicable methods.        (let ((fn (etypecase callable
665  ;;;                    (fast-method-call (fast-method-call-function callable))
666  (defun set-emf-name (gf methods callable)                    (method-call (method-call-function callable))
667    (when *named-emfs-p*                    (function callable))))
668      (let ((function (typecase callable          (setf (fdefinition (make-emf-name gf methods)) fn)))
669                        (fast-method-call (fast-method-call-function callable))      callable))
                       (method-call (method-call-function callable))  
                       (t callable)))  
           (name (make-emf-name gf methods)))  
       (setf (fdefinition name) function)  
       (set-function-name function name)))  
   callable)  
670    
671  ;;;  ;;;
672  ;;; Return a name for an effective method of generic function GF,  ;;; Return a name for an effective method of generic function GF,
# Line 484  Line 687 
687    
688  (defun make-emf-name (gf methods)  (defun make-emf-name (gf methods)
689    (let* ((early-p (early-gf-p gf))    (let* ((early-p (early-gf-p gf))
690           (gf-name (if early-p           (gf-name (generic-function-name* gf))
                      (early-gf-name gf)  
                      (generic-function-name gf)))  
691           (emf-name           (emf-name
692            (if (or early-p            (if (or early-p
693                    (eq (generic-function-method-combination gf)                    (eq (generic-function-method-combination gf)

Legend:
Removed from v.1.13.2.1  
changed lines
  Added in v.1.26

  ViewVC Help
Powered by ViewVC 1.1.5