Changeset 14059
- Timestamp:
- 08/05/12 20:40:13 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r14058 r14059 1166 1166 aux)))) 1167 1167 1168 (defmacro getk (plist key init-form)1169 "Similar to getf except eval and return INIT-FORM if KEY has no value in PLIST."1170 (let ((not-exist (gensym))1171 (value (gensym)))1172 `(let ((,value (getf ,plist ,key ',not-exist)))1173 (if (eq ',not-exist ,value) ,init-form ,value))))1174 1175 1168 (defun wrap-with-call-method-macro (gf args-var emf-form) 1176 1169 `(macrolet … … 1276 1269 `((,whole ',args-var))) 1277 1270 ,@(when rest 1271 ;; ### TODO: use a fresh symbol for the rest 1272 ;; binding being generated and pushed into binding-forms 1278 1273 `((,rest (progn 1279 1274 (push `(,',rest … … 1282 1277 ,binding-forms) 1283 1278 ',rest)))) 1284 ,@(loop for var in required 1285 and i upfrom 01279 ,@(loop for var in required and i upfrom 0 1280 for var-binding = (gensym) 1286 1281 collect `(,var (when (< ,i nreq) 1287 `(nth ,,i ,',args-var)))) 1282 (push `(,',var-binding 1283 (nth ,,i ,',args-var)) 1284 ,binding-forms) 1285 ',var-binding))) 1288 1286 ,@(loop for (var initform supplied-var) in optional 1289 1287 and i upfrom 0 … … 1303 1301 (when (< ,i nopt) 1304 1302 (setq ,needs-args-len-var t) 1303 ;; ### TODO: use a fresh symbol for the supplied binding 1304 ;; binding being generated and pushed into binding-forms 1305 1305 (push `(,',supplied-binding 1306 1306 (< ,(+ ,i nreq) ,',args-len-var)) … … 1324 1324 collect `(,supplied-binding 1325 1325 (progn 1326 ;; ### TODO: use a fresh symbol for the rest 1327 ;; binding being generated and pushed into binding-forms 1326 1328 (push `(,',supplied-binding 1327 (member ,',key ,',rest))) 1329 (member ,',key ,',rest)) 1330 ,binding-forms) 1328 1331 ',supplied-binding)) 1329 1332 collect `(,var (progn … … 1332 1335 (cadr ,',supplied-binding) 1333 1336 ,',initform)) 1334 ,binding-forms)))) 1337 ,binding-forms) 1338 ',var-binding))) 1335 1339 ,@(loop for (var initform) in aux 1336 1340 for var-binding = (gensym)
Note: See TracChangeset
for help on using the changeset viewer.