Changeset 14052


Ignore:
Timestamp:
08/04/12 12:56:29 (9 years ago)
Author:
ehuelsmann
Message:

Integrate WITH-ARGS-LAMBDA-LIST in COMPUTE-METHOD-TYPE-LAMBDA
for me to understand what's going on and to open up performance
improvement opportunities in the near future.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r14046 r14052  
    12011201     ,emf-form))
    12021202
    1203 (defmacro with-args-lambda-list (args-lambda-list
    1204                                  generic-function-symbol
    1205                                  gf-args-symbol
    1206                                  &body forms)
    1207   (let ((gf-lambda-list (gensym))
    1208         (nrequired (gensym))
    1209         (noptional (gensym))
    1210         (rest-args (gensym)))
    1211     (multiple-value-bind (whole required optional rest keys aux)
    1212         (parse-define-method-combination-args-lambda-list args-lambda-list)
    1213       `(let* ((,gf-lambda-list (slot-value ,generic-function-symbol 'sys::lambda-list))
    1214               (,nrequired (length (extract-required-part ,gf-lambda-list)))
    1215               (,noptional (length (extract-optional-part ,gf-lambda-list)))
    1216               (,rest-args (subseq ,gf-args-symbol (+ ,nrequired ,noptional)))
    1217               ,@(when whole `((,whole ,gf-args-symbol)))
    1218               ,@(loop for var in required and i upfrom 0
    1219                   collect `(,var (when (< ,i ,nrequired)
    1220                                    (nth ,i ,gf-args-symbol))))
    1221               ,@(loop for (var init-form) in optional and i upfrom 0
    1222                   collect
    1223                   `(,var (if (< ,i ,noptional)
    1224                              (nth (+ ,nrequired ,i) ,gf-args-symbol)
    1225                              ,init-form)))
    1226               ,@(when rest `((,rest ,rest-args)))
    1227               ,@(loop for ((key var) init-form) in keys and i upfrom 0
    1228                   collect `(,var (getk ,rest-args ',key ,init-form)))
    1229               ,@(loop for (var init-form) in aux and i upfrom 0
    1230                   collect `(,var ,init-form)))
    1231          ,@forms))))
    1232 
    12331203(defun assert-unambiguous-method-sorting (group-name methods)
    12341204  (let ((specializers (make-hash-table :test 'equal)))
     
    12851255  (declare (ignore name))
    12861256  (let ((methods (gensym))
    1287         (args-var (gensym)))
     1257        (args-var (gensym))
     1258        (gf-lambda-list (gensym))
     1259        (emf-form (gensym)))
    12881260    `(lambda (,generic-function-symbol ,methods ,@lambda-list)
     1261       ;; This is the lambda which computes the effective method
    12891262       ,@declarations
    12901263       (with-method-groups ,method-group-specs
    12911264           ,methods
    12921265         ,(if (null args-lambda-list)
    1293               `(let ((emf-form (progn ,@forms)))
     1266              `(let ((,emf-form (progn ,@forms)))
    12941267                 `(lambda (,',args-var)
     1268                    ;; This is the lambda which *is* the effective method
     1269                    ;; hence gets called on every method invocation
     1270                    ;; be as efficient in this method as we can be
    12951271                    ,(wrap-with-call-method-macro ,generic-function-symbol
    1296                                                   ',args-var emf-form)))
    1297               `(lambda (,args-var)
    1298                  (let* ((emf-form
    1299                          (with-args-lambda-list ,args-lambda-list
    1300                              ,generic-function-symbol ,args-var
    1301                            ,@forms))
    1302                         (function
    1303                          `(lambda (,',args-var) ;; ugly: we're reusing it
    1304                           ;; to prevent calling gensym on every EMF invocation
    1305                           ,(wrap-with-call-method-macro ,generic-function-symbol
    1306                                                         ',args-var emf-form))))
    1307                    (funcall function ,args-var))))))))
     1272                                                  ',args-var ,emf-form)))
     1273              (multiple-value-bind
     1274                    (whole required optional rest keys aux)
     1275                  (parse-define-method-combination-args-lambda-list args-lambda-list)
     1276                `(let* ((,gf-lambda-list (slot-value ,generic-function-symbol
     1277                                                     'sys::lambda-list))
     1278                        (nreq (length (extract-required-part ,gf-lambda-list)))
     1279                        (nopt (length (extract-optional-part ,gf-lambda-list)))
     1280                        (,emf-form
     1281                         (let* (,@(when whole
     1282                                        `((,whole ',args-var)))
     1283                                ,@(when rest
     1284                                        `((,rest `(subseq ,',args-var
     1285                                                          (+ ,nreq ,nopt)))))
     1286                                ,@(loop for var in required
     1287                                     and i upfrom 0
     1288                                     collect `(,var (when (< ,i nreq)
     1289                                                      `(nth ,,i ,',args-var))))
     1290                                ,@(loop for (var initform) in optional
     1291                                     and i upfrom 0
     1292                                     ;; check for excess parameters
     1293                                     ;; only assign initform if the parameter
     1294                                     ;; isn't in excess: the spec says explicitly
     1295                                     ;; to bind those in excess to forms evaluating
     1296                                     ;; to nil.
     1297                                     ;; This leaves initforms to be used with
     1298                                     ;; parameters not supplied in excess, but
     1299                                     ;; not available arguments list
     1300                                     ;;
     1301                                     ;; Also, if specified, bind "supplied-p"
     1302                                     collect `(,var (if (< ,i nopt)
     1303                                                        `(nth ,(+ ,i nreq)
     1304                                                              ,',args-var)
     1305                                                        ',initform)))
     1306                                ,@(loop for ((key var) initform) in keys
     1307                                     ;; Same as optional parameters:
     1308                                     ;; even though keywords can't be supplied in
     1309                                     ;; excess, we should bind "supplied-p" in case
     1310                                     ;; the key isn't supplied in the arguments list
     1311                                     collect `(,var `(getk (subseq ,',args-var
     1312                                                                   (+ ,nreq ,nopt)) ,',key
     1313                                                                   ,',initform)))
     1314                                ,@(loop for (var initform) in aux
     1315                                     collect `(,var ',initform)))
     1316                           ,@forms)))
     1317                   `(lambda (,',args-var)
     1318                      ;; This is the lambda which *is* the effective method
     1319                      ;; hence gets called on every method invocation
     1320                      ;; be as efficient in this method as we can be
     1321                      ,(wrap-with-call-method-macro ,generic-function-symbol
     1322                                                    ',args-var ,emf-form)))))))))
    13081323
    13091324(defun declarationp (expr)
Note: See TracChangeset for help on using the changeset viewer.