| Revision | d3bbaf103e84aaeb0cb25829a1aa87eafa6d2da6 (tree) |
|---|---|
| Time | 2019-10-10 13:10:01 |
| Author | Agustina Arzille <avarzille@rise...> |
| Commiter | Agustina Arzille |
Reimplement some things
function.cpp (diff)
goodies/vim/syntax/quipu.vim (diff) sys.qp (diff)| @@ -300,8 +300,8 @@ | ||
| 300 | 300 | else |
| 301 | 301 | interp->raise ("dispatch-error", "no suitable method found"); |
| 302 | 302 | |
| 303 | - argc -= 2; // Skip code an cache. | |
| 304 | 303 | interp->stkend -= interpreter::frame_size; |
| 304 | + argc -= 2; // Skip code and cache. | |
| 305 | 305 | *(interp->stkend - argc - 1) = xaref (*rv, 0); |
| 306 | 306 | interp->cur_frame = as_int (interp->stack[interp->cur_frame - 4]); |
| 307 | 307 | return (call_n (interp, argc)); |
| @@ -16,7 +16,7 @@ | ||
| 16 | 16 | syntax keyword qpCond if when unless |
| 17 | 17 | syntax keyword qpDefine defct defmac defvar defalias defconst defmeth deftype |
| 18 | 18 | syntax keyword qpMacro and or |
| 19 | -syntax keyword qpFunc * + - / = < <= > >= not symbol-p str str-p kword-p int-p fct-p print puts str eval list list-p array array-p table table-p tuple tuple-p cons concat count apply map atom-p car cdr cadr cddr list* != gensym use coro-p caar cdar cons-p nreverse len char-p float-p bvector-p pkg-p | |
| 19 | +syntax keyword qpFunc * + - / = < <= > >= not symbol-p str str-p kword-p int-p fct-p print puts str eval list list-p array array-p table table-p tuple tuple-p cons concat count apply map atom-p car cdr cadr cddr list* != gensym use coro-p caar cdar cons-p nreverse len char-p float-p bvector-p pkg-p is | |
| 20 | 20 | syntax keyword qpVariable *out* *in* *err* *argv* |
| 21 | 21 | |
| 22 | 22 | " Keywords are symbols: |
| @@ -409,41 +409,45 @@ | ||
| 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 | - | |
| 422 | 412 | (defct %meth-args (args) |
| 423 | 413 | (let rv nil |
| 424 | 414 | (while (cons-p args) |
| 425 | 415 | (let arg (car args) |
| 426 | - (setf rv (cons (if | |
| 427 | - (array-p arg) (arg 0) | |
| 428 | - (list-p arg) (list (car arg) '%METH-TOKEN) | |
| 429 | - arg) rv) | |
| 430 | - args (cdr args)))) | |
| 416 | + (setf args (cdr args) | |
| 417 | + rv (cons (if (array-p arg) (arg 0) | |
| 418 | + (list-p arg) (list (car arg) '%METH-TOKEN) | |
| 419 | + arg) | |
| 420 | + rv)))) | |
| 431 | 421 | (if args |
| 432 | 422 | (nrevconc rv args) |
| 433 | 423 | (nreverse rv)))) |
| 434 | 424 | |
| 435 | 425 | (defct %meth-types (args) |
| 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)))))) | |
| 426 | + (let rv nil | |
| 427 | + (while (cons-p args) | |
| 428 | + (let arg (car args) | |
| 429 | + (if (list-p arg) | |
| 430 | + (break)) | |
| 431 | + (setf args (cdr args) | |
| 432 | + rv (cons (if (array-p arg) | |
| 433 | + (if (> (len arg) 2) | |
| 434 | + (raise (%mkexc "arg-error" | |
| 435 | + "invalid method argument: ${arg}")) | |
| 436 | + (arg 1))) | |
| 437 | + rv)))) | |
| 438 | + (nreverse rv))) | |
| 443 | 439 | |
| 444 | 440 | (defct %meth-argnames (args) |
| 445 | - (%meth-argsmap args | |
| 446 | - (fct (arg) arg))) | |
| 441 | + (let rv nil | |
| 442 | + (while (cons-p args) | |
| 443 | + (let arg (car args) | |
| 444 | + (setf rv (if (and (list-p arg) (kword-p (car arg))) | |
| 445 | + (list* (intern (symname (car arg))) (car arg)) | |
| 446 | + (cons (if (list-p arg) (car arg) arg) rv)) | |
| 447 | + args (cdr args)))) | |
| 448 | + (if args | |
| 449 | + (setf rv (cons args rv))) | |
| 450 | + (nreverse rv))) | |
| 447 | 451 | |
| 448 | 452 | (defmac defmeth (name args . body) |
| 449 | 453 | (if (or (not args) (not (list-p args))) |
| @@ -478,5 +482,10 @@ | ||
| 478 | 482 | nil ,gmeth) |
| 479 | 483 | (list %METH-TOKEN ,gmeth ,@(%meth-types args)) |
| 480 | 484 | ;; fill the rest of the arguments with nil. |
| 481 | - ,@(%meth-argsmap fct-args (fct (x) nil))) | |
| 485 | + ,@((fct (x acc) | |
| 486 | + (if (or (not (cons-p x)) | |
| 487 | + (list-p (car x))) | |
| 488 | + acc | |
| 489 | + (recur (cdr x) (cons nil acc)))) | |
| 490 | + (cdr fct-args) nil)) | |
| 482 | 491 | ) ) ) |
Fork