Changeset 14053
- Timestamp:
- 08/04/12 13:57:20 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r14052 r14053 1250 1250 ,@forms)))) 1251 1251 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 1252 1308 (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 1254 1311 method-group-specs declarations forms &allow-other-keys) 1255 1312 (declare (ignore name)) 1256 1313 (let ((methods (gensym)) 1257 1314 (args-var (gensym)) 1258 (gf-lambda-list (gensym))1259 1315 (emf-form (gensym))) 1260 1316 `(lambda (,generic-function-symbol ,methods ,@lambda-list) … … 1271 1327 ,(wrap-with-call-method-macro ,generic-function-symbol 1272 1328 ',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)))))) 1323 1330 1324 1331 (defun declarationp (expr)
Note: See TracChangeset
for help on using the changeset viewer.