Changeset 14054
- Timestamp:
- 08/04/12 21:18:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r14053 r14054 1255 1255 (whole required optional rest keys aux) 1256 1256 (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)) 1259 1264 (emf-form (gensym))) 1260 1265 `(let* ((,gf-lambda-list (slot-value ,generic-function-symbol … … 1262 1267 (nreq (length (extract-required-part ,gf-lambda-list))) 1263 1268 (nopt (length (extract-optional-part ,gf-lambda-list))) 1269 (,binding-forms) 1270 (,needs-args-len-var) 1264 1271 (,emf-form 1265 1272 (let* (,@(when whole … … 1272 1279 collect `(,var (when (< ,i nreq) 1273 1280 `(nth ,,i ,',args-var)))) 1274 ,@(loop for (var initform ) in optional1281 ,@(loop for (var initform supplied-var) in optional 1275 1282 and i upfrom 0 1283 for supplied-binding = (or supplied-var 1284 (when initform (gensym))) 1285 for var-binding = (gensym) 1276 1286 ;; check for excess parameters 1277 1287 ;; only assign initform if the parameter 1278 1288 ;; isn't in excess: the spec says explicitly 1279 ;; to bind thosein excess to forms evaluating1289 ;; to bind parameters in excess to forms evaluating 1280 1290 ;; to nil. 1281 1291 ;; This leaves initforms to be used with 1282 1292 ;; parameters not supplied in excess, but 1283 ;; not available arguments list1293 ;; not available in the arguments list 1284 1294 ;; 1285 1295 ;; 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))) 1290 1312 ,@(loop for ((key var) initform) in keys 1291 1313 ;; Same as optional parameters: … … 1297 1319 ,',initform))) 1298 1320 ,@(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)))) 1300 1326 ,@forms))) 1301 1327 `(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))))))) 1307 1339 1308 1340 (defun method-combination-type-lambda
Note: See TracChangeset
for help on using the changeset viewer.