• R/O
  • SSH

quipu: Commit

quipu mercurial repository


Commit MetaInfo

Revision3458984fc12160cb85c605adbf6bdb299d402fee (tree)
Zeit2019-01-17 02:50:10
AutorAgustina Arzille <avarzille@rise...>
CommiterAgustina Arzille

Log Message

Implement the nzap interface for tuples

Ändern Zusammenfassung

Diff

diff -r e01a52b2d1a1 -r 3458984fc121 array.cpp
--- a/array.cpp Tue Jan 15 16:03:13 2019 -0300
+++ b/array.cpp Wed Jan 16 14:50:10 2019 -0300
@@ -313,6 +313,8 @@
313313 {
314314 if (qp_unlikely (!fixint_p (key)))
315315 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");
316318
317319 array *ap = as_array (obj);
318320 if (qp_unlikely (ap->flagged_p (FLAGS_CONST)))
diff -r e01a52b2d1a1 -r 3458984fc121 builtins.cpp
--- a/builtins.cpp Tue Jan 15 16:03:13 2019 -0300
+++ b/builtins.cpp Wed Jan 16 14:50:10 2019 -0300
@@ -1515,16 +1515,20 @@
15151515
15161516 DEFBUILTIN (nzap_fct)
15171517 {
1518+ uint32_t flags = (fixint_p (argv[2]) ? as_int (argv[2]) : 0) |
1519+ (!singlethr_p () ? NZAP_MT : 0);
1520+
15181521 #define DISPATCH(type, suffix) \
15191522 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))
15221525
15231526 switch (itype (*argv))
15241527 {
15251528 DISPATCH (ARRAY, a);
15261529 DISPATCH (CONS, L);
15271530 DISPATCH (TABLE, u);
1531+ DISPATCH (TUPLE, o);
15281532 default:
15291533 invalid_arg (interp, "nzap");
15301534 }
diff -r e01a52b2d1a1 -r 3458984fc121 cons.cpp
--- a/cons.cpp Tue Jan 15 16:03:13 2019 -0300
+++ b/cons.cpp Wed Jan 16 14:50:10 2019 -0300
@@ -457,6 +457,8 @@
457457 {
458458 if (qp_unlikely (!fixint_p (key)))
459459 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");
460462
461463 interp->growstk (argc + 1);
462464 interp->push (fn);
diff -r e01a52b2d1a1 -r 3458984fc121 table.cpp
--- a/table.cpp Tue Jan 15 16:03:13 2019 -0300
+++ b/table.cpp Wed Jan 16 14:50:10 2019 -0300
@@ -469,7 +469,7 @@
469469 return (empty);
470470 }
471471
472-struct inserter
472+struct table_inserter
473473 {
474474 object val;
475475
@@ -487,7 +487,7 @@
487487 static bool
488488 table_put_lk (interpreter *interp, table *tp, object key, object val)
489489 {
490- inserter ins;
490+ table_inserter ins;
491491 ins.val = val;
492492 return (table_update_lk (interp, tp, key, ins));
493493 }
@@ -556,11 +556,12 @@
556556 if (qp_unlikely (tp->flagged_p (FLAGS_CONST)))
557557 interp->raise_const ("nput:table");
558558
559- inserter ins;
559+ table_inserter ins;
560560 ins.val = val;
561561
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);
564565
565566 if (ret)
566567 gc_wbarrier (interp, tab, key);
@@ -625,14 +626,14 @@
625626 (mtsafe ? table_clr_mt : table_clr_lk) (interp, tp);
626627 }
627628
628-struct nzapper
629+struct table_nzapper
629630 {
630631 valref ret;
631632 object dfl;
632633 int stack_idx;
633634 int nargs;
634635
635- nzapper (interpreter *interp, uint32_t flags,
636+ table_nzapper (interpreter *interp, uint32_t flags,
636637 object fn, object *argv, int argc) : ret (interp, fixint (0))
637638 {
638639 interp->growstk (argc + 1);
@@ -674,11 +675,17 @@
674675 if (qp_unlikely (tp->flagged_p (FLAGS_CONST)))
675676 interp->raise_const ("nzap:table");
676677
677- nzapper nz (interp, flags, fn, argv, argc);
678+ table_nzapper nz (interp, flags, fn, argv, argc);
679+ bool wb;
680+
678681 if (flags & NZAP_MT)
679- table_update_mt<nzapper> (interp, tp, key, nz);
682+ wb = table_update_mt<table_nzapper> (interp, tp, key, nz);
680683 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);
682689
683690 qp_return (*nz.ret);
684691 }
diff -r e01a52b2d1a1 -r 3458984fc121 tuple.cpp
--- a/tuple.cpp Tue Jan 15 16:03:13 2019 -0300
+++ b/tuple.cpp Wed Jan 16 14:50:10 2019 -0300
@@ -192,26 +192,39 @@
192192 ap.l_succs[lvl] = ap.item;
193193 }
194194
195- return (d == 0 ? node_key (ap.other) : UNBOUND);
195+ return (d == 0 ? ap.other : UNBOUND);
196196 }
197197
198198 static object
199199 tuple_get_lk (interpreter *interp, tuple *tp,
200200 tuple_args& ap, object key)
201201 {
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));
203204 }
204205
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)
208216 {
209217 int n = rand_levels (interp, tp);
218+ object tmp = find_preds_lk (interp, tp, ap, n, key, UNLINK_NONE);
210219
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+ }
213225
214226 object nval = make_node (interp, n, key);
227+ f.call (interp, node_key (nval));
215228
216229 // Set the new element's successor and link it into the tuple.
217230 for (int lvl = 0; lvl < n; ++lvl)
@@ -224,6 +237,14 @@
224237 return (true);
225238 }
226239
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+
227248 static bool
228249 tuple_del_lk (interpreter *interp, tuple *tp,
229250 tuple_args& ap, object key)
@@ -304,14 +325,15 @@
304325 ap.l_succs[lvl] = ap.item;
305326 }
306327
307- return (d == 0 && ap.item != UNBOUND ? node_key (ap.item) : UNBOUND);
328+ return (d == 0 && ap.item != UNBOUND ? ap.item : UNBOUND);
308329 }
309330
310-static object
331+static inline object
311332 tuple_get_mt (interpreter *interp, tuple *tp,
312333 tuple_args& ap, object key)
313334 {
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);
315337 }
316338
317339 static inline bool
@@ -327,17 +349,22 @@
327349 }
328350 }
329351
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)
333355 {
334356 valref root (interp, UNBOUND);
335357 retry:
336358 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+ }
339365
340366 object nval = make_node (interp, n, key);
367+ f.call (interp, node_key (nval));
341368
342369 ap.next = node_next (nval, 0) = *ap.l_succs;
343370 for (int lvl = 1; lvl < n; ++lvl)
@@ -387,6 +414,14 @@
387414 return (true);
388415 }
389416
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+
390425 static bool
391426 tuple_del_mt (interpreter *interp, tuple *tp,
392427 tuple_args& ap, object key)
@@ -503,6 +538,60 @@
503538 atomic_mfence_rel ();
504539 }
505540
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+
506595 tuple::iterator::iterator (interpreter *interp, object tx) : node (interp, tx)
507596 {
508597 *this->node = node_next (as_tuple(tx)->head, 0);
diff -r e01a52b2d1a1 -r 3458984fc121 tuple.h
--- a/tuple.h Tue Jan 15 16:03:13 2019 -0300
+++ b/tuple.h Wed Jan 16 14:50:10 2019 -0300
@@ -76,6 +76,9 @@
7676
7777 QP_EXPORT void tuple_clr (interpreter *__interp, object __tuple);
7878
79+QP_EXPORT object nzap_o (interpreter *__interp, object __obj, object __key,
80+ uint32_t __flags, object __fn, object *__argv, int __argc);
81+
7982 QP_EXPORT object tuple_union (interpreter *__interp,
8083 object __tuple1, object __tuple2);
8184
Show on old repository browser