quipu mercurial repository
Revision | 3458984fc12160cb85c605adbf6bdb299d402fee (tree) |
---|---|
Zeit | 2019-01-17 02:50:10 |
Autor | Agustina Arzille <avarzille@rise...> |
Commiter | Agustina Arzille |
Implement the nzap interface for tuples
@@ -313,6 +313,8 @@ | ||
313 | 313 | { |
314 | 314 | if (qp_unlikely (!fixint_p (key))) |
315 | 315 | interp->raise2 ("type-error", "nzap:array: index is not an integer"); |
316 | + else if (qp_unlikely (flags & NZAP_DFL)) | |
317 | + interp->raise2 ("arg-error", "nzap:array: default argument not supported"); | |
316 | 318 | |
317 | 319 | array *ap = as_array (obj); |
318 | 320 | if (qp_unlikely (ap->flagged_p (FLAGS_CONST))) |
@@ -1515,16 +1515,20 @@ | ||
1515 | 1515 | |
1516 | 1516 | DEFBUILTIN (nzap_fct) |
1517 | 1517 | { |
1518 | + uint32_t flags = (fixint_p (argv[2]) ? as_int (argv[2]) : 0) | | |
1519 | + (!singlethr_p () ? NZAP_MT : 0); | |
1520 | + | |
1518 | 1521 | #define DISPATCH(type, suffix) \ |
1519 | 1522 | case typecode::type: \ |
1520 | - return (nzap_##suffix (interp, argv[0], argv[1], fixint_p (argv[2]) ? \ | |
1521 | - as_int (argv[2]) : 0, argv[3], &argv[4], argc - 4)) | |
1523 | + return (nzap_##suffix (interp, argv[0], argv[1], flags, \ | |
1524 | + argv[3], &argv[4], argc - 4)) | |
1522 | 1525 | |
1523 | 1526 | switch (itype (*argv)) |
1524 | 1527 | { |
1525 | 1528 | DISPATCH (ARRAY, a); |
1526 | 1529 | DISPATCH (CONS, L); |
1527 | 1530 | DISPATCH (TABLE, u); |
1531 | + DISPATCH (TUPLE, o); | |
1528 | 1532 | default: |
1529 | 1533 | invalid_arg (interp, "nzap"); |
1530 | 1534 | } |
@@ -457,6 +457,8 @@ | ||
457 | 457 | { |
458 | 458 | if (qp_unlikely (!fixint_p (key))) |
459 | 459 | interp->raise2 ("type-error", "nzap:cons: index is not an integer"); |
460 | + else if (qp_unlikely (flags & NZAP_DFL)) | |
461 | + interp->raise2 ("arg-error", "nzap:cons: default argument not supported"); | |
460 | 462 | |
461 | 463 | interp->growstk (argc + 1); |
462 | 464 | interp->push (fn); |
@@ -469,7 +469,7 @@ | ||
469 | 469 | return (empty); |
470 | 470 | } |
471 | 471 | |
472 | -struct inserter | |
472 | +struct table_inserter | |
473 | 473 | { |
474 | 474 | object val; |
475 | 475 |
@@ -487,7 +487,7 @@ | ||
487 | 487 | static bool |
488 | 488 | table_put_lk (interpreter *interp, table *tp, object key, object val) |
489 | 489 | { |
490 | - inserter ins; | |
490 | + table_inserter ins; | |
491 | 491 | ins.val = val; |
492 | 492 | return (table_update_lk (interp, tp, key, ins)); |
493 | 493 | } |
@@ -556,11 +556,12 @@ | ||
556 | 556 | if (qp_unlikely (tp->flagged_p (FLAGS_CONST))) |
557 | 557 | interp->raise_const ("nput:table"); |
558 | 558 | |
559 | - inserter ins; | |
559 | + table_inserter ins; | |
560 | 560 | ins.val = val; |
561 | 561 | |
562 | - bool ret = (mtsafe ? table_update_mt<inserter> : table_update_lk<inserter>) | |
563 | - (interp, as_table (tab), key, ins); | |
562 | + bool ret = (mtsafe ? | |
563 | + table_update_mt<table_inserter> : table_update_lk<table_inserter>) | |
564 | + (interp, as_table (tab), key, ins); | |
564 | 565 | |
565 | 566 | if (ret) |
566 | 567 | gc_wbarrier (interp, tab, key); |
@@ -625,14 +626,14 @@ | ||
625 | 626 | (mtsafe ? table_clr_mt : table_clr_lk) (interp, tp); |
626 | 627 | } |
627 | 628 | |
628 | -struct nzapper | |
629 | +struct table_nzapper | |
629 | 630 | { |
630 | 631 | valref ret; |
631 | 632 | object dfl; |
632 | 633 | int stack_idx; |
633 | 634 | int nargs; |
634 | 635 | |
635 | - nzapper (interpreter *interp, uint32_t flags, | |
636 | + table_nzapper (interpreter *interp, uint32_t flags, | |
636 | 637 | object fn, object *argv, int argc) : ret (interp, fixint (0)) |
637 | 638 | { |
638 | 639 | interp->growstk (argc + 1); |
@@ -674,11 +675,17 @@ | ||
674 | 675 | if (qp_unlikely (tp->flagged_p (FLAGS_CONST))) |
675 | 676 | interp->raise_const ("nzap:table"); |
676 | 677 | |
677 | - nzapper nz (interp, flags, fn, argv, argc); | |
678 | + table_nzapper nz (interp, flags, fn, argv, argc); | |
679 | + bool wb; | |
680 | + | |
678 | 681 | if (flags & NZAP_MT) |
679 | - table_update_mt<nzapper> (interp, tp, key, nz); | |
682 | + wb = table_update_mt<table_nzapper> (interp, tp, key, nz); | |
680 | 683 | else |
681 | - table_update_lk<nzapper> (interp, tp, key, nz); | |
684 | + wb = table_update_lk<table_nzapper> (interp, tp, key, nz); | |
685 | + | |
686 | + gc_wbarrier (interp, obj, key); | |
687 | + if (wb) | |
688 | + gc_wbarrier (interp, obj, interp->retval); | |
682 | 689 | |
683 | 690 | qp_return (*nz.ret); |
684 | 691 | } |
@@ -192,26 +192,39 @@ | ||
192 | 192 | ap.l_succs[lvl] = ap.item; |
193 | 193 | } |
194 | 194 | |
195 | - return (d == 0 ? node_key (ap.other) : UNBOUND); | |
195 | + return (d == 0 ? ap.other : UNBOUND); | |
196 | 196 | } |
197 | 197 | |
198 | 198 | static object |
199 | 199 | tuple_get_lk (interpreter *interp, tuple *tp, |
200 | 200 | tuple_args& ap, object key) |
201 | 201 | { |
202 | - return (find_preds_lk (interp, tp, ap, 0, key, UNLINK_NONE)); | |
202 | + object ret = find_preds_lk (interp, tp, ap, 0, key, UNLINK_NONE); | |
203 | + return (ret != UNBOUND ? ret : node_key (ret)); | |
203 | 204 | } |
204 | 205 | |
205 | -static bool | |
206 | -tuple_put_lk (interpreter *interp, tuple *tp, | |
207 | - tuple_args& ap, object key) | |
206 | +struct tuple_inserter | |
207 | +{ | |
208 | + void call (interpreter *, object&) | |
209 | + { | |
210 | + } | |
211 | +}; | |
212 | + | |
213 | +template <class Fn> | |
214 | +static bool tuple_update_lk (interpreter *interp, | |
215 | + tuple *tp, tuple_args& ap, object key, Fn& f) | |
208 | 216 | { |
209 | 217 | int n = rand_levels (interp, tp); |
218 | + object tmp = find_preds_lk (interp, tp, ap, n, key, UNLINK_NONE); | |
210 | 219 | |
211 | - if (find_preds_lk (interp, tp, ap, n, key, UNLINK_NONE) != UNBOUND) | |
212 | - return (false); | |
220 | + if (tmp != UNBOUND) | |
221 | + { | |
222 | + f.call (interp, node_key (tmp)); | |
223 | + return (false); | |
224 | + } | |
213 | 225 | |
214 | 226 | object nval = make_node (interp, n, key); |
227 | + f.call (interp, node_key (nval)); | |
215 | 228 | |
216 | 229 | // Set the new element's successor and link it into the tuple. |
217 | 230 | for (int lvl = 0; lvl < n; ++lvl) |
@@ -224,6 +237,14 @@ | ||
224 | 237 | return (true); |
225 | 238 | } |
226 | 239 | |
240 | +static inline bool | |
241 | +tuple_put_lk (interpreter *interp, tuple *tp, | |
242 | + tuple_args& ap, object key) | |
243 | +{ | |
244 | + tuple_inserter ins; | |
245 | + return (tuple_update_lk (interp, tp, ap, key, ins)); | |
246 | +} | |
247 | + | |
227 | 248 | static bool |
228 | 249 | tuple_del_lk (interpreter *interp, tuple *tp, |
229 | 250 | tuple_args& ap, object key) |
@@ -304,14 +325,15 @@ | ||
304 | 325 | ap.l_succs[lvl] = ap.item; |
305 | 326 | } |
306 | 327 | |
307 | - return (d == 0 && ap.item != UNBOUND ? node_key (ap.item) : UNBOUND); | |
328 | + return (d == 0 && ap.item != UNBOUND ? ap.item : UNBOUND); | |
308 | 329 | } |
309 | 330 | |
310 | -static object | |
331 | +static inline object | |
311 | 332 | tuple_get_mt (interpreter *interp, tuple *tp, |
312 | 333 | tuple_args& ap, object key) |
313 | 334 | { |
314 | - return (find_preds_mt (interp, tp, ap, 0, key, UNLINK_NONE)); | |
335 | + object ret = find_preds_mt (interp, tp, ap, 0, key, UNLINK_NONE); | |
336 | + return (ret != UNBOUND ? node_key (ret) : ret); | |
315 | 337 | } |
316 | 338 | |
317 | 339 | static inline bool |
@@ -327,17 +349,22 @@ | ||
327 | 349 | } |
328 | 350 | } |
329 | 351 | |
330 | -static bool | |
331 | -tuple_put_mt (interpreter *interp, tuple *tp, | |
332 | - tuple_args& ap, object key) | |
352 | +template <class Fn> | |
353 | +static bool tuple_update_mt (interpreter *interp, | |
354 | + tuple *tp, tuple_args& ap, object key, Fn& f) | |
333 | 355 | { |
334 | 356 | valref root (interp, UNBOUND); |
335 | 357 | retry: |
336 | 358 | int n = rand_levels (interp, tp); |
337 | - if (find_preds_mt (interp, tp, ap, n, key, UNLINK_ASSIST, &*root) != UNBOUND) | |
338 | - return (false); | |
359 | + object tmp = find_preds_mt (interp, tp, ap, n, key, UNLINK_ASSIST, &*root); | |
360 | + if (tmp != UNBOUND) | |
361 | + { | |
362 | + f.call (interp, node_key (tmp)); | |
363 | + return (false); | |
364 | + } | |
339 | 365 | |
340 | 366 | object nval = make_node (interp, n, key); |
367 | + f.call (interp, node_key (nval)); | |
341 | 368 | |
342 | 369 | ap.next = node_next (nval, 0) = *ap.l_succs; |
343 | 370 | for (int lvl = 1; lvl < n; ++lvl) |
@@ -387,6 +414,14 @@ | ||
387 | 414 | return (true); |
388 | 415 | } |
389 | 416 | |
417 | +static inline bool | |
418 | +tuple_put_mt (interpreter *interp, tuple *tp, | |
419 | + tuple_args& ap, object key) | |
420 | +{ | |
421 | + tuple_inserter ins; | |
422 | + return (tuple_update_mt (interp, tp, ap, key, ins)); | |
423 | +} | |
424 | + | |
390 | 425 | static bool |
391 | 426 | tuple_del_mt (interpreter *interp, tuple *tp, |
392 | 427 | tuple_args& ap, object key) |
@@ -503,6 +538,60 @@ | ||
503 | 538 | atomic_mfence_rel (); |
504 | 539 | } |
505 | 540 | |
541 | +struct tuple_nzapper | |
542 | +{ | |
543 | + valref ret; | |
544 | + int stack_idx; | |
545 | + int nargs; | |
546 | + | |
547 | + tuple_nzapper (interpreter *interp, object fn, | |
548 | + object *argv, int argc) : ret (interp, fixint (0)) | |
549 | + { | |
550 | + interp->growstk (argc + 1); | |
551 | + interp->push (fn); | |
552 | + interp->push (fixint (0)); | |
553 | + this->stack_idx = interp->stklen () - 1; | |
554 | + | |
555 | + for (int i = 0; i < argc; ++i) | |
556 | + interp->push (argv[i]); | |
557 | + | |
558 | + this->nargs = argc + 1; | |
559 | + } | |
560 | + | |
561 | + void call (interpreter *interp, object& out) | |
562 | + { | |
563 | + *this->ret = interp->stack[this->stack_idx] = out; | |
564 | + out = call_n (interp, this->nargs); | |
565 | + } | |
566 | +}; | |
567 | + | |
568 | +object nzap_o (interpreter *interp, object obj, object key, | |
569 | + uint32_t flags, object fn, object *argv, int argc) | |
570 | +{ | |
571 | + if (flags & NZAP_DFL) | |
572 | + interp->raise2 ("arg-error", "nzap:tuple: default argument not supported"); | |
573 | + | |
574 | + tuple *tp = as_tuple (obj); | |
575 | + if (qp_unlikely (tp->flagged_p (FLAGS_CONST))) | |
576 | + interp->raise_const ("nzap:tuple"); | |
577 | + | |
578 | + object space[4 + MAX_DEPTH * 2]; | |
579 | + tuple_args args (interp, space, QP_NELEM (space), true, true); | |
580 | + | |
581 | + tuple_nzapper nz (interp, fn, argv, argc); | |
582 | + bool wb; | |
583 | + | |
584 | + if (flags & NZAP_MT) | |
585 | + wb = tuple_update_mt<tuple_nzapper> (interp, tp, args, key, nz); | |
586 | + else | |
587 | + wb = tuple_update_lk<tuple_nzapper> (interp, tp, args, key, nz); | |
588 | + | |
589 | + if (wb) | |
590 | + gc_wbarrier (interp, obj, key); | |
591 | + | |
592 | + qp_return (*nz.ret); | |
593 | +} | |
594 | + | |
506 | 595 | tuple::iterator::iterator (interpreter *interp, object tx) : node (interp, tx) |
507 | 596 | { |
508 | 597 | *this->node = node_next (as_tuple(tx)->head, 0); |
@@ -76,6 +76,9 @@ | ||
76 | 76 | |
77 | 77 | QP_EXPORT void tuple_clr (interpreter *__interp, object __tuple); |
78 | 78 | |
79 | +QP_EXPORT object nzap_o (interpreter *__interp, object __obj, object __key, | |
80 | + uint32_t __flags, object __fn, object *__argv, int __argc); | |
81 | + | |
79 | 82 | QP_EXPORT object tuple_union (interpreter *__interp, |
80 | 83 | object __tuple1, object __tuple2); |
81 | 84 |