Changeset 14054


Ignore:
Timestamp:
08/04/12 21:18:00 (9 years ago)
Author:
ehuelsmann
Message:

More efficient arguments option variable references (&optional and &aux)
and support for supplied-p parameters (&optional) for long form D-M-C.

File:
1 edited

Legend:

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

    r14053 r14054  
    12551255        (whole required optional rest keys aux)
    12561256      (parse-define-method-combination-args-lambda-list args-lambda-list)
    1257     (let ((gf-lambda-list (gensym))
    1258           (args-var (gensym))
     1257    (let* ((gf-lambda-list (gensym))
     1258           (args-var (gensym))
     1259           (args-len-var (when (or (some #'second optional)
     1260                                   (some #'second keys))
     1261                           (gensym)))
     1262           (binding-forms (gensym))
     1263           (needs-args-len-var (gensym))
    12591264          (emf-form (gensym)))
    12601265      `(let* ((,gf-lambda-list (slot-value ,generic-function-symbol
     
    12621267              (nreq (length (extract-required-part ,gf-lambda-list)))
    12631268              (nopt (length (extract-optional-part ,gf-lambda-list)))
     1269              (,binding-forms)
     1270              (,needs-args-len-var)
    12641271              (,emf-form
    12651272               (let* (,@(when whole
     
    12721279                             collect `(,var (when (< ,i nreq)
    12731280                                              `(nth ,,i ,',args-var))))
    1274                         ,@(loop for (var initform) in optional
     1281                        ,@(loop for (var initform supplied-var) in optional
    12751282                             and i upfrom 0
     1283                             for supplied-binding = (or supplied-var
     1284                                                        (when initform (gensym)))
     1285                             for var-binding = (gensym)
    12761286                             ;; check for excess parameters
    12771287                             ;; only assign initform if the parameter
    12781288                             ;; isn't in excess: the spec says explicitly
    1279                              ;; to bind those in excess to forms evaluating
     1289                             ;; to bind parameters in excess to forms evaluating
    12801290                             ;; to nil.
    12811291                             ;; This leaves initforms to be used with
    12821292                             ;; parameters not supplied in excess, but
    1283                              ;; not available arguments list
     1293                             ;; not available in the arguments list
    12841294                             ;;
    12851295                             ;; Also, if specified, bind "supplied-p"
    1286                              collect `(,var (if (< ,i nopt)
    1287                                                 `(nth ,(+ ,i nreq)
    1288                                                       ,',args-var)
    1289                                                 ',initform)))
     1296                             if supplied-binding
     1297                             collect `(,supplied-binding
     1298                                       (when (< ,i nopt)
     1299                                         (setq ,needs-args-len-var t)
     1300                                         (push `(,',supplied-binding
     1301                                                 (< ,(+ ,i nreq) ,',args-len-var))
     1302                                               ,binding-forms)
     1303                                         ',supplied-binding))
     1304                             collect `(,var (when (< ,i nopt)
     1305                                              (push `(,',var-binding
     1306                                                      (if ,',supplied-binding
     1307                                                          (nth ,(+ ,i nreq)
     1308                                                               ,',args-var)
     1309                                                          ,',initform))
     1310                                                    ,binding-forms)
     1311                                              ',var-binding)))
    12901312                        ,@(loop for ((key var) initform) in keys
    12911313                             ;; Same as optional parameters:
     
    12971319                                                           ,',initform)))
    12981320                        ,@(loop for (var initform) in aux
    1299                              collect `(,var ',initform)))
     1321                             for var-binding = (gensym)
     1322                             collect `(,var (progn
     1323                                              (push '(,var-binding ,initform)
     1324                                                    ,binding-forms)
     1325                                              ',var-binding))))
    13001326                 ,@forms)))
    13011327         `(lambda (,',args-var)
    1302             ;; This is the lambda which *is* the effective method
    1303             ;; hence gets called on every method invocation
    1304             ;; be as efficient in this method as we can be
    1305             ,(wrap-with-call-method-macro ,generic-function-symbol
    1306                                           ',args-var ,emf-form))))))
     1328            ;; set up bindings to ensure the expressions to which the
     1329            ;; variables of the arguments option have been bound are
     1330            ;; evaluated exactly once.
     1331            (let* (,@(when ,needs-args-len-var
     1332                           `((,',args-len-var (length ,',args-var))))
     1333                   ,@(reverse ,binding-forms))
     1334              ;; This is the lambda which *is* the effective method
     1335              ;; hence gets called on every method invocation
     1336              ;; be as efficient in this method as we can be
     1337              ,(wrap-with-call-method-macro ,generic-function-symbol
     1338                                            ',args-var ,emf-form)))))))
    13071339
    13081340(defun method-combination-type-lambda
Note: See TracChangeset for help on using the changeset viewer.