| Revision | 54981a38d9be2fcfbad14f0e1b103dee68522528 (tree) |
|---|---|
| Time | 2019-10-10 05:15:37 |
| Author | Agustina Arzille <avarzille@rise...> |
| Commiter | Agustina Arzille |
Improve method dispatching for optional parameters
function.cpp (diff)
sys.qp (diff)| @@ -287,7 +287,7 @@ | ||
| 287 | 287 | |
| 288 | 288 | valref pred (interp, fixint (0)), succ (interp, fixint (0)); |
| 289 | 289 | valref rv (interp, tuple_nearest (interp, cache, types.as_obj (), |
| 290 | - &*pred, &*succ)); | |
| 290 | + &*pred, &*succ)); | |
| 291 | 291 | |
| 292 | 292 | if (*rv != UNBOUND) |
| 293 | 293 | ; |
| @@ -409,38 +409,41 @@ | ||
| 409 | 409 | (defct %meth-flag (fn) |
| 410 | 410 | (%meth-ctl 3 fn)) |
| 411 | 411 | |
| 412 | +(defct %meth-argsmap (args fn) | |
| 413 | + (let rv nil | |
| 414 | + (while (cons-p args) | |
| 415 | + (let arg (car args) | |
| 416 | + (if (list-p arg) | |
| 417 | + (break) | |
| 418 | + (setf rv (cons (fn arg) rv) | |
| 419 | + args (cdr args))))) | |
| 420 | + (nreverse rv))) | |
| 421 | + | |
| 412 | 422 | (defct %meth-args (args) |
| 413 | 423 | (let rv nil |
| 414 | 424 | (while (cons-p args) |
| 415 | 425 | (let arg (car args) |
| 416 | 426 | (setf rv (cons (if |
| 417 | 427 | (array-p arg) (arg 0) |
| 418 | - (list-p arg) (list (car arg) nil) | |
| 419 | - arg) | |
| 420 | - rv) | |
| 428 | + (list-p arg) (list (car arg) '%METH-TOKEN) | |
| 429 | + arg) rv) | |
| 421 | 430 | args (cdr args)))) |
| 422 | 431 | (if args |
| 423 | 432 | (nrevconc rv args) |
| 424 | 433 | (nreverse rv)))) |
| 425 | 434 | |
| 426 | 435 | (defct %meth-types (args) |
| 427 | - (let rv nil | |
| 428 | - (while (and (cons-p args) (not (kword-p (car args)))) | |
| 429 | - (let arg (car args) | |
| 430 | - (setf args (cdr args) | |
| 431 | - rv (cons (if (array-p arg) | |
| 432 | - (if (> (len arg) 2) | |
| 433 | - (raise (%mkexc "arg-error" | |
| 434 | - "invalid method argument: ${arg}")) | |
| 435 | - (arg 1))) | |
| 436 | - rv)))) | |
| 437 | - (nreverse rv))) | |
| 436 | + (%meth-argsmap args | |
| 437 | + (fct (arg) | |
| 438 | + (if (array-p arg) | |
| 439 | + (if (> (len arg) 2) | |
| 440 | + (raise (%mkexc "arg-error" | |
| 441 | + "invalid method argument: ${arg}")) | |
| 442 | + (arg 1)))))) | |
| 438 | 443 | |
| 439 | 444 | (defct %meth-argnames (args) |
| 440 | - (let rv nil | |
| 441 | - (each arg args | |
| 442 | - (setf rv (cons (if (list-p arg) (car arg) arg) rv))) | |
| 443 | - (nreverse rv))) | |
| 445 | + (%meth-argsmap args | |
| 446 | + (fct (arg) arg))) | |
| 444 | 447 | |
| 445 | 448 | (defmac defmeth (name args . body) |
| 446 | 449 | (if (or (not args) (not (list-p args))) |
| @@ -475,10 +478,5 @@ | ||
| 475 | 478 | nil ,gmeth) |
| 476 | 479 | (list %METH-TOKEN ,gmeth ,@(%meth-types args)) |
| 477 | 480 | ;; fill the rest of the arguments with nil. |
| 478 | - ,@((fct (x acc) | |
| 479 | - (if (or (not (list-p x)) | |
| 480 | - (list-p (car x))) | |
| 481 | - acc | |
| 482 | - (recur (cdr x) (cons nil acc)))) | |
| 483 | - (cdr fct-args) nil)) | |
| 481 | + ,@(%meth-argsmap fct-args (fct (x) nil))) | |
| 484 | 482 | ) ) ) |
Fork