Commit e473af523be9126a039ae469e2c126a948b7c676
2024-11-09T15:34:38
first draft list_sort_by
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
diff --git a/lib/kc3/0.1/list.kc3 b/lib/kc3/0.1/list.kc3
index e174d04..493bd50 100644
--- a/lib/kc3/0.1/list.kc3
+++ b/lib/kc3/0.1/list.kc3
@@ -61,4 +61,6 @@ defmodule List do
def sort = cfn List "list_sort" (List, Result)
+ def sort_by = cfn List "list_sort_by" (List, Fn, Result)
+
end
diff --git a/libkc3/list.c b/libkc3/list.c
index 696b503..f1ecb85 100644
--- a/libkc3/list.c
+++ b/libkc3/list.c
@@ -14,11 +14,13 @@
#include "alloc.h"
#include "assert.h"
#include "array.h"
+#include "bool.h"
#include "buf.h"
#include "buf_inspect.h"
#include "buf_parse.h"
#include "compare.h"
#include "data.h"
+#include "eval.h"
#include "list.h"
#include "sym.h"
#include "tag.h"
@@ -330,6 +332,60 @@ s_list ** list_sort (const s_list * const *list, s_list **dest)
return dest;
}
+s_list ** list_sort_by (const s_list * const *list, const s_fn *compare,
+ s_list **dest)
+{
+ s_list *arg1;
+ s_list *arg2;
+ bool b;
+ const s_list *l;
+ s_list *new_;
+ const s_sym *sym_Bool = &g_sym_Bool;
+ s_list *tmp;
+ s_list **t;
+ s_tag tag;
+ assert(list);
+ assert(dest);
+ if (! (arg2 = list_new(NULL)))
+ return NULL;
+ if (! (arg1 = list_new(arg2))) {
+ list_delete(arg2);
+ return NULL;
+ }
+ tmp = NULL;
+ l = *list;
+ while (l) {
+ t = &tmp;
+ if (! tag_init_copy(&arg1->tag, &(*t)->tag))
+ goto ko;
+ if (! tag_init_copy(&arg2->tag, &l->tag))
+ goto ko;
+ while (*t) {
+ if (! eval_fn_call(compare, arg1, &tag))
+ goto ko;
+ if (! bool_init_cast(&b, &sym_Bool, &tag)) {
+ tag_clean(&tag);
+ goto ko;
+ }
+ tag_clean(&tag);
+ if (! b)
+ break;
+ t = &(*t)->next.data.list;
+ }
+ if (! (new_ = list_new_tag_copy(&l->tag, *t)))
+ goto ko;
+ *t = new_;
+ l = list_next(l);
+ }
+ list_delete_all(arg1);
+ *dest = tmp;
+ return dest;
+ ko:
+ list_delete_all(tmp);
+ list_delete_all(arg1);
+ return NULL;
+}
+
s_list ** list_tail (s_list **list)
{
s_list **tail;