Ignore:
Timestamp:
10/12/09 20:33:59 (12 years ago)
Author:
ehuelsmann
Message:

Move non-exact closure generation to the outer scope, reducing

the size of function STD-COMPUTE-DISCRIMINATING-FUNCTION.

File:
1 edited

Legend:

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

    r12190 r12191  
    12401240                                              '(&rest &optional &key
    12411241                                                &allow-other-keys &aux)))))
    1242               (cond
    1243                 ((= number-required 1)
    1244                  (if exact
     1242              (if exact
     1243                  (cond
     1244                    ((= number-required 1)
    12451245                     (cond
    12461246                       ((and (eq (generic-function-method-combination gf) 'standard)
     
    12761276                              (if emfun
    12771277                                  (funcall emfun (list arg))
    1278                                   (apply #'no-applicable-method gf (list arg)))))
    1279                         ))
    1280                      #'(lambda (&rest args)
    1281                          (declare (optimize speed))
    1282                          (unless (>= (length args) 1)
    1283                            (error 'program-error
    1284                                   :format-control "Not enough arguments for generic function ~S."
    1285                                   :format-arguments (list (%generic-function-name gf))))
    1286                          (let ((emfun (get-cached-emf gf args)))
    1287                            (if emfun
    1288                                (funcall emfun args)
    1289                                (slow-method-lookup gf args))))))
    1290                 ((= number-required 2)
    1291                  (if exact
     1278                                  (apply #'no-applicable-method gf (list arg))))))))
     1279                    ((= number-required 2)
    12921280                     #'(lambda (arg1 arg2)
    12931281                         (declare (optimize speed))
     
    12961284                           (if emfun
    12971285                               (funcall emfun args)
    1298                                (slow-method-lookup gf args))))
    1299                      #'(lambda (&rest args)
    1300                          (declare (optimize speed))
    1301                          (unless (>= (length args) 2)
    1302                            (error 'program-error
    1303                                   :format-control "Not enough arguments for generic function ~S."
    1304                                   :format-arguments (list (%generic-function-name gf))))
    1305                          (let ((emfun (get-cached-emf gf args)))
    1306                            (if emfun
    1307                                (funcall emfun args)
    1308                                (slow-method-lookup gf args))))))
    1309                 ((= number-required 3)
    1310                  (if exact
     1286                               (slow-method-lookup gf args)))))
     1287                    ((= number-required 3)
    13111288                     #'(lambda (arg1 arg2 arg3)
    13121289                         (declare (optimize speed))
     
    13151292                           (if emfun
    13161293                               (funcall emfun args)
    1317                                (slow-method-lookup gf args))))
     1294                               (slow-method-lookup gf args)))))
     1295                    (t
    13181296                     #'(lambda (&rest args)
    13191297                         (declare (optimize speed))
    1320                          (unless (>= (length args) 3)
    1321                            (error 'program-error
    1322                                   :format-control "Not enough arguments for generic function ~S."
    1323                                   :format-arguments (list (%generic-function-name gf))))
     1298                         (let ((len (length args)))
     1299                           (unless (= len number-required)
     1300                             (error 'program-error
     1301                                    :format-control "Not enough arguments for generic function ~S."
     1302                                    :format-arguments (list (%generic-function-name gf)))))
    13241303                         (let ((emfun (get-cached-emf gf args)))
    13251304                           (if emfun
    13261305                               (funcall emfun args)
    13271306                               (slow-method-lookup gf args))))))
    1328                 (t
    1329                  #'(lambda (&rest args)
    1330                      (declare (optimize speed))
    1331                      (let ((len (length args)))
    1332                        (unless (or (and exact
    1333                                         (= len number-required))
    1334                                    (>= len number-required))
    1335                          (error 'program-error
    1336                                 :format-control "Not enough arguments for generic function ~S."
    1337                                 :format-arguments (list (%generic-function-name gf)))))
    1338                      (let ((emfun (get-cached-emf gf args)))
    1339                        (if emfun
    1340                            (funcall emfun args)
    1341                            (slow-method-lookup gf args)))))))))))
     1307                  #'(lambda (&rest args)
     1308                      (declare (optimize speed))
     1309                      (let ((len (length args)))
     1310                        (unless (>= len number-required)
     1311                          (error 'program-error
     1312                                 :format-control "Not enough arguments for generic function ~S."
     1313                                 :format-arguments (list (%generic-function-name gf)))))
     1314                      (let ((emfun (get-cached-emf gf args)))
     1315                        (if emfun
     1316                            (funcall emfun args)
     1317                            (slow-method-lookup gf args))))))))))
    13421318
    13431319    code))
Note: See TracChangeset for help on using the changeset viewer.