Changeset 14053


Ignore:
Timestamp:
08/04/12 13:57:20 (9 years ago)
Author:
ehuelsmann
Message:

Factor out the emf generating code from METHOD-COMBINATION-TYPE-LAMBDA
into its own function.

File:
1 edited

Legend:

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

    r14052 r14053  
    12501250         ,@forms))))
    12511251
     1252(defun method-combination-type-lambda-with-args-emf
     1253    (&key args-lambda-list generic-function-symbol forms &allow-other-keys)
     1254  (multiple-value-bind
     1255        (whole required optional rest keys aux)
     1256      (parse-define-method-combination-args-lambda-list args-lambda-list)
     1257    (let ((gf-lambda-list (gensym))
     1258          (args-var (gensym))
     1259          (emf-form (gensym)))
     1260      `(let* ((,gf-lambda-list (slot-value ,generic-function-symbol
     1261                                           'sys::lambda-list))
     1262              (nreq (length (extract-required-part ,gf-lambda-list)))
     1263              (nopt (length (extract-optional-part ,gf-lambda-list)))
     1264              (,emf-form
     1265               (let* (,@(when whole
     1266                              `((,whole ',args-var)))
     1267                      ,@(when rest
     1268                              `((,rest `(subseq ,',args-var
     1269                                                (+ ,nreq ,nopt)))))
     1270                        ,@(loop for var in required
     1271                             and i upfrom 0
     1272                             collect `(,var (when (< ,i nreq)
     1273                                              `(nth ,,i ,',args-var))))
     1274                        ,@(loop for (var initform) in optional
     1275                             and i upfrom 0
     1276                             ;; check for excess parameters
     1277                             ;; only assign initform if the parameter
     1278                             ;; isn't in excess: the spec says explicitly
     1279                             ;; to bind those in excess to forms evaluating
     1280                             ;; to nil.
     1281                             ;; This leaves initforms to be used with
     1282                             ;; parameters not supplied in excess, but
     1283                             ;; not available arguments list
     1284                             ;;
     1285                             ;; Also, if specified, bind "supplied-p"
     1286                             collect `(,var (if (< ,i nopt)
     1287                                                `(nth ,(+ ,i nreq)
     1288                                                      ,',args-var)
     1289                                                ',initform)))
     1290                        ,@(loop for ((key var) initform) in keys
     1291                             ;; Same as optional parameters:
     1292                             ;; even though keywords can't be supplied in
     1293                             ;; excess, we should bind "supplied-p" in case
     1294                             ;; the key isn't supplied in the arguments list
     1295                             collect `(,var `(getk (subseq ,',args-var
     1296                                                           (+ ,nreq ,nopt)) ,',key
     1297                                                           ,',initform)))
     1298                        ,@(loop for (var initform) in aux
     1299                             collect `(,var ',initform)))
     1300                 ,@forms)))
     1301         `(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))))))
     1307
    12521308(defun method-combination-type-lambda
    1253   (&key name lambda-list args-lambda-list generic-function-symbol
     1309  (&rest all-args
     1310   &key name lambda-list args-lambda-list generic-function-symbol
    12541311        method-group-specs declarations forms &allow-other-keys)
    12551312  (declare (ignore name))
    12561313  (let ((methods (gensym))
    12571314        (args-var (gensym))
    1258         (gf-lambda-list (gensym))
    12591315        (emf-form (gensym)))
    12601316    `(lambda (,generic-function-symbol ,methods ,@lambda-list)
     
    12711327                    ,(wrap-with-call-method-macro ,generic-function-symbol
    12721328                                                  ',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)))))))))
     1329              (apply #'method-combination-type-lambda-with-args-emf all-args))))))
    13231330
    13241331(defun declarationp (expr)
Note: See TracChangeset for help on using the changeset viewer.