lists.c - tomo

(792 lines)
   1 // Functions that operate on lists
   2 
   3 #include <gc.h>
   4 #include <math.h>
   5 #include <stdbool.h>
   6 #include <stdint.h>
   7 #include <sys/param.h>
   8 
   9 #include "integers.h"
  10 #include "lists.h"
  11 #include "math.h"
  12 #include "metamethods.h"
  13 #include "optionals.h"
  14 #include "tables.h"
  15 #include "text.h"
  16 #include "util.h"
  17 
  18 // Use inline version of siphash code:
  19 #include "siphash-internals.h"
  20 
  21 public
  22 char _EMPTY_LIST_SENTINEL = '\0';
  23 
  24 PUREFUNC static INLINE int64_t get_padded_item_size(const TypeInfo_t *info) {
  25     int64_t size = info->ListInfo.item->size;
  26     if (info->ListInfo.item->align > 1 && size % info->ListInfo.item->align) errx(1, "Item size is not padded!");
  27     return size;
  28 }
  29 
  30 // Replace the list's .data pointer with a new pointer to a copy of the
  31 // data that is compacted and has a stride of exactly `padded_item_size`
  32 public
  33 void List$compact(List_t *list, int64_t padded_item_size) {
  34     void *copy = NULL;
  35     if (list->length > 0) {
  36         copy = list->atomic ? GC_MALLOC_ATOMIC((size_t)list->length * (size_t)padded_item_size)
  37                             : GC_MALLOC((size_t)list->length * (size_t)padded_item_size);
  38         if ((int64_t)list->stride == padded_item_size) {
  39             memcpy(copy, list->data, (size_t)list->length * (size_t)padded_item_size);
  40         } else {
  41             for (int64_t i = 0; i < (int64_t)list->length; i++)
  42                 memcpy(copy + i * padded_item_size, list->data + list->stride * i, (size_t)padded_item_size);
  43         }
  44     }
  45     *list = (List_t){
  46         .data = copy,
  47         .length = list->length,
  48         .stride = padded_item_size,
  49         .atomic = list->atomic,
  50     };
  51 }
  52 
  53 public
  54 void List$insert(List_t *list, const void *item, Int_t int_index, int64_t padded_item_size) {
  55     int64_t index = Int64$from_int(int_index, false);
  56     if (index <= 0) index = (int64_t)list->length + index + 1;
  57 
  58     if (index < 1) index = 1;
  59     else if (index > (int64_t)list->length + 1)
  60         fail("Invalid insertion index ", index, " for a list with length ", (int64_t)list->length);
  61 
  62     if (!list->data) {
  63         list->free = 4;
  64         list->data = list->atomic ? GC_MALLOC_ATOMIC((size_t)list->free * (size_t)padded_item_size)
  65                                   : GC_MALLOC((size_t)list->free * (size_t)padded_item_size);
  66         list->stride = padded_item_size;
  67     } else if (list->free < 1 || list->data_refcount != 0 || (int64_t)list->stride != padded_item_size) {
  68         // Resize policy: +50% growth (clamped between 8 and LIST_MAX_FREE_ENTRIES)
  69         list->free = MIN(LIST_MAX_FREE_ENTRIES, MAX(8, list->length) / 2);
  70         void *copy = list->atomic ? GC_MALLOC_ATOMIC((size_t)(list->length + list->free) * (size_t)padded_item_size)
  71                                   : GC_MALLOC((size_t)(list->length + list->free) * (size_t)padded_item_size);
  72         for (int64_t i = 0; i < index - 1; i++)
  73             memcpy(copy + i * padded_item_size, list->data + list->stride * i, (size_t)padded_item_size);
  74         for (int64_t i = index - 1; i < (int64_t)list->length; i++)
  75             memcpy(copy + (i + 1) * padded_item_size, list->data + list->stride * i, (size_t)padded_item_size);
  76         list->data = copy;
  77         list->data_refcount = 0;
  78         list->stride = padded_item_size;
  79     } else {
  80         if (index != (int64_t)list->length + 1) {
  81             assert((int64_t)list->length >= index);
  82             size_t size = (size_t)(((int64_t)list->length - index + 1) * padded_item_size);
  83             assert(size < SIZE_MAX);
  84             memmove(list->data + index * padded_item_size, list->data + (index - 1) * padded_item_size, size);
  85         }
  86     }
  87     assert(list->free > 0);
  88     --list->free;
  89     ++list->length;
  90     memcpy((void *)list->data + (index - 1) * padded_item_size, item, (size_t)padded_item_size);
  91 }
  92 
  93 public
  94 void List$insert_all(List_t *list, List_t to_insert, Int_t int_index, int64_t padded_item_size) {
  95     int64_t index = Int64$from_int(int_index, false);
  96     if (to_insert.length == 0) return;
  97 
  98     if (!list->data) {
  99         *list = to_insert;
 100         LIST_INCREF(*list);
 101         return;
 102     }
 103 
 104     if (index < 1) index = (int64_t)list->length + index + 1;
 105 
 106     if (index < 1) index = 1;
 107     else if (index > (int64_t)list->length + 1)
 108         fail("Invalid insertion index ", index, " for a list with length ", (int64_t)list->length);
 109 
 110     if ((int64_t)list->free >= (int64_t)to_insert.length // Adequate free space
 111         && list->data_refcount == 0 // Not aliased memory
 112         && (int64_t)list->stride == padded_item_size) { // Contiguous list
 113         // If we can fit this within the list's preallocated free space, do that:
 114         list->free -= to_insert.length;
 115         list->length += to_insert.length;
 116         if (index != (int64_t)list->length + 1) {
 117             // Move the data from insertion index onwards forwards
 118             void *from = (void *)list->data + (index - 1) * padded_item_size;
 119             void *to = (void *)list->data + (index - 1 + (int64_t)to_insert.length) * padded_item_size;
 120             int64_t count = (int64_t)list->length - index;
 121             memmove(to, from, (size_t)(count * padded_item_size));
 122         }
 123         for (int64_t i = 0; i < (int64_t)to_insert.length; i++) {
 124             memcpy((void *)list->data + (index - 1 + i) * padded_item_size, to_insert.data + i * to_insert.stride,
 125                    (size_t)padded_item_size);
 126         }
 127     } else {
 128         // Otherwise, allocate a new chunk of memory for the list and populate it:
 129         uint64_t new_len = list->length + to_insert.length;
 130         uint64_t free = MIN(LIST_MAX_FREE_ENTRIES, MAX(8, new_len / 4));
 131         void *data = list->atomic ? GC_MALLOC_ATOMIC((size_t)((new_len + free) * (uint64_t)padded_item_size))
 132                                   : GC_MALLOC((size_t)((new_len + free) * (uint64_t)padded_item_size));
 133         void *p = data;
 134 
 135         // Copy first chunk of `list` if needed:
 136         if (index > 1) {
 137             if (list->stride == padded_item_size) {
 138                 memcpy(p, list->data, (size_t)((index - 1) * padded_item_size));
 139                 p += (index - 1) * padded_item_size;
 140             } else {
 141                 for (int64_t i = 0; i < index - 1; i++) {
 142                     memcpy(p, list->data + list->stride * i, (size_t)padded_item_size);
 143                     p += padded_item_size;
 144                 }
 145             }
 146         }
 147 
 148         // Copy `to_insert`
 149         if (to_insert.stride == padded_item_size) {
 150             memcpy(p, to_insert.data, (size_t)((int64_t)to_insert.length * padded_item_size));
 151             p += (int64_t)to_insert.length * padded_item_size;
 152         } else {
 153             for (int64_t i = 0; i < (int64_t)to_insert.length; i++) {
 154                 memcpy(p, to_insert.data + to_insert.stride * i, (size_t)padded_item_size);
 155                 p += padded_item_size;
 156             }
 157         }
 158 
 159         // Copy last chunk of `list` if needed:
 160         if (index < (int64_t)list->length + 1) {
 161             if (list->stride == padded_item_size) {
 162                 memcpy(p, list->data + padded_item_size * (index - 1),
 163                        (size_t)(((int64_t)list->length - index + 1) * padded_item_size));
 164             } else {
 165                 for (int64_t i = index - 1; i < (int64_t)list->length - 1; i++) {
 166                     memcpy(p, list->data + list->stride * i, (size_t)padded_item_size);
 167                     p += padded_item_size;
 168                 }
 169             }
 170         }
 171         *list = (List_t){
 172             .data = data,
 173             .length = (uint64_t)new_len,
 174             .free = free,
 175             .atomic = list->atomic,
 176             .data_refcount = 0,
 177             .stride = padded_item_size,
 178         };
 179     }
 180 }
 181 
 182 public
 183 void List$remove_at(List_t *list, Int_t int_index, Int_t int_count, int64_t padded_item_size) {
 184     int64_t index = Int64$from_int(int_index, false);
 185     if (index < 1) index = (int64_t)list->length + index + 1;
 186 
 187     int64_t count = Int64$from_int(int_count, false);
 188     if (index < 1 || index > (int64_t)list->length || count < 1) return;
 189 
 190     if (count > (int64_t)list->length - index + 1) count = ((int64_t)list->length - index) + 1;
 191 
 192     if (index == 1) {
 193         list->data += list->stride * count;
 194     } else if (index + count > (int64_t)list->length) {
 195         list->free += count;
 196     } else if (list->data_refcount != 0 || (int64_t)list->stride != padded_item_size) {
 197         void *copy = list->atomic ? GC_MALLOC_ATOMIC((size_t)(((int64_t)list->length - 1) * padded_item_size))
 198                                   : GC_MALLOC((size_t)(((int64_t)list->length - 1) * padded_item_size));
 199         for (int64_t src = 1, dest = 1; src <= (int64_t)list->length; src++) {
 200             if (src < index || src >= index + count) {
 201                 memcpy(copy + (dest - 1) * padded_item_size, list->data + list->stride * (src - 1),
 202                        (size_t)padded_item_size);
 203                 ++dest;
 204             }
 205         }
 206         list->data = copy;
 207         list->free = 0;
 208         list->data_refcount = 0;
 209     } else {
 210         memmove((void *)list->data + (index - 1) * padded_item_size,
 211                 list->data + (index - 1 + count) * padded_item_size,
 212                 (size_t)(((int64_t)list->length - index + count - 1) * padded_item_size));
 213         list->free += count;
 214     }
 215     list->length -= (uint64_t)count;
 216     if (list->length == 0) list->data = NULL;
 217 }
 218 
 219 public
 220 void List$remove_item(List_t *list, void *item, Int_t max_removals, const TypeInfo_t *type) {
 221     int64_t padded_item_size = get_padded_item_size(type);
 222     const Int_t ZERO = (Int_t){.small = (0 << 2) | 1};
 223     const Int_t ONE = (Int_t){.small = (1 << 2) | 1};
 224     const TypeInfo_t *item_type = type->ListInfo.item;
 225     for (int64_t i = 0; i < (int64_t)list->length;) {
 226         if (max_removals.small == ZERO.small) // zero
 227             break;
 228 
 229         if (generic_equal(item, list->data + i * list->stride, item_type)) {
 230             List$remove_at(list, I(i + 1), ONE, padded_item_size);
 231             max_removals = Int$minus(max_removals, ONE);
 232         } else {
 233             i++;
 234         }
 235     }
 236 }
 237 
 238 public
 239 OptionalInt_t List$find(List_t list, void *item, const TypeInfo_t *type) {
 240     const TypeInfo_t *item_type = type->ListInfo.item;
 241     for (int64_t i = 0; i < (int64_t)list.length; i++) {
 242         if (generic_equal(item, list.data + i * list.stride, item_type)) return I(i + 1);
 243     }
 244     return NONE_INT;
 245 }
 246 
 247 public
 248 OptionalInt_t List$first(List_t list, Closure_t predicate) {
 249     bool (*is_good)(void *, void *) = (void *)predicate.fn;
 250     for (int64_t i = 0; i < (int64_t)list.length; i++) {
 251         if (is_good(list.data + i * list.stride, predicate.userdata)) return I(i + 1);
 252     }
 253     return NONE_INT;
 254 }
 255 
 256 static Closure_t _sort_comparison = {.fn = NULL};
 257 
 258 int _compare_closure(const void *a, const void *b) {
 259     typedef int (*comparison_t)(const void *, const void *, void *);
 260     return ((comparison_t)_sort_comparison.fn)(a, b, _sort_comparison.userdata);
 261 }
 262 
 263 public
 264 void List$sort(List_t *list, Closure_t comparison, int64_t padded_item_size) {
 265     if (list->data_refcount != 0 || (int64_t)list->stride != padded_item_size) List$compact(list, padded_item_size);
 266 
 267     _sort_comparison = comparison;
 268     qsort(list->data, (size_t)list->length, (size_t)padded_item_size, _compare_closure);
 269 }
 270 
 271 public
 272 List_t List$sorted(List_t list, Closure_t comparison, int64_t padded_item_size) {
 273     List$compact(&list, padded_item_size);
 274     _sort_comparison = comparison;
 275     qsort(list.data, (size_t)list.length, (size_t)padded_item_size, _compare_closure);
 276     return list;
 277 }
 278 
 279 #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__APPLE__)
 280 #include <stdlib.h>
 281 static ssize_t getrandom(void *buf, size_t buflen, unsigned int flags) {
 282     (void)flags;
 283     arc4random_buf(buf, buflen);
 284     return buflen;
 285 }
 286 #elif defined(__linux__)
 287 // Use getrandom()
 288 #include <sys/random.h>
 289 #else
 290 #error "Unsupported platform for secure random number generation"
 291 #endif
 292 
 293 static int64_t _default_random_int64(int64_t min, int64_t max, void *userdata) {
 294     (void)userdata;
 295     if (min > max) fail("Random minimum value (", min, ") is larger than the maximum value (", max, ")");
 296     if (min == max) return min;
 297     uint64_t range = (uint64_t)max - (uint64_t)min + 1;
 298     uint64_t min_r = -range % range;
 299     uint64_t r;
 300     for (;;) {
 301         assert(getrandom(&r, sizeof(r), 0) == sizeof(r));
 302         if (r >= min_r) break;
 303     }
 304     return (int64_t)((uint64_t)min + (r % range));
 305 }
 306 
 307 public
 308 void List$shuffle(List_t *list, OptionalClosure_t random_int64, int64_t padded_item_size) {
 309     if (list->data_refcount != 0 || (int64_t)list->stride != padded_item_size) List$compact(list, padded_item_size);
 310 
 311     typedef int64_t (*rng_fn_t)(int64_t, int64_t, void *);
 312     rng_fn_t rng_fn = random_int64.fn ? (rng_fn_t)random_int64.fn : _default_random_int64;
 313     char tmp[padded_item_size];
 314     for (int64_t i = (int64_t)list->length - 1; i > 1; i--) {
 315         int64_t j = rng_fn(0, i, random_int64.userdata);
 316         if unlikely (j < 0 || j > (int64_t)list->length - 1)
 317             fail("The provided random number function returned an invalid value: ", j, " (not between 0 and ", i, ")");
 318         memcpy(tmp, list->data + i * padded_item_size, (size_t)padded_item_size);
 319         memcpy((void *)list->data + i * padded_item_size, list->data + j * padded_item_size, (size_t)padded_item_size);
 320         memcpy((void *)list->data + j * padded_item_size, tmp, (size_t)padded_item_size);
 321     }
 322 }
 323 
 324 public
 325 List_t List$shuffled(List_t list, Closure_t random_int64, int64_t padded_item_size) {
 326     List$compact(&list, padded_item_size);
 327     List$shuffle(&list, random_int64, padded_item_size);
 328     return list;
 329 }
 330 
 331 public
 332 void *List$random(List_t list, OptionalClosure_t random_int64) {
 333     if (list.length == 0) return NULL; // fail("Cannot get a random item from an empty list!");
 334 
 335     typedef int64_t (*rng_fn_t)(int64_t, int64_t, void *);
 336     rng_fn_t rng_fn = random_int64.fn ? (rng_fn_t)random_int64.fn : _default_random_int64;
 337     int64_t index = rng_fn(0, (int64_t)list.length - 1, random_int64.userdata);
 338     if unlikely (index < 0 || index > (int64_t)list.length - 1)
 339         fail("The provided random number function returned an invalid value: ", index, " (not between 0 and ",
 340              (int64_t)list.length, ")");
 341     return list.data + list.stride * index;
 342 }
 343 
 344 public
 345 Table_t List$counts(List_t list, const TypeInfo_t *type) {
 346     Table_t counts = EMPTY_TABLE;
 347     TypeInfo_t count_type = *Table$info(type->ListInfo.item, &Int$info);
 348     for (int64_t i = 0; i < (int64_t)list.length; i++) {
 349         void *key = list.data + i * list.stride;
 350         Int_t *count = Table$get(counts, key, &count_type);
 351         Int_t val = count ? Int$plus(*count, I(1)) : I(1);
 352         Table$set(&counts, key, &val, &count_type);
 353     }
 354     return counts;
 355 }
 356 
 357 static double _default_random_num(void *userdata) {
 358     (void)userdata;
 359     union {
 360         Num_t num;
 361         uint64_t bits;
 362     } r = {.bits = 0}, one = {.num = 1.0};
 363     assert(getrandom((uint8_t *)&r, sizeof(r), 0) == sizeof(r));
 364 
 365     // Set r.num to 1.<random-bits>
 366     r.bits &= ~(0xFFFULL << 52);
 367     r.bits |= (one.bits & (0xFFFULL << 52));
 368     return r.num - 1.0;
 369 }
 370 
 371 public
 372 List_t List$sample(List_t list, Int_t int_n, List_t weights, OptionalClosure_t random_num, int64_t padded_item_size) {
 373     int64_t n = Int64$from_int(int_n, false);
 374     if (n < 0) fail("Cannot select a negative number of values");
 375 
 376     if (n == 0) return EMPTY_LIST;
 377 
 378     if (list.length == 0) fail("There are no elements in this list!");
 379 
 380     if (weights.length != list.length)
 381         fail("List has ", (int64_t)list.length, " elements, but there are ", (int64_t)weights.length, " weights given");
 382 
 383     double total = 0.0;
 384     for (int64_t i = 0; i < (int64_t)weights.length && i < (int64_t)list.length; i++) {
 385         double weight = *(double *)(weights.data + weights.stride * i);
 386         if (isinf(weight)) fail("Infinite weight!");
 387         else if (isnan(weight)) fail("NaN weight!");
 388         else if (weight < 0.0) fail("Negative weight!");
 389         else total += weight;
 390     }
 391 
 392     if (isinf(total)) fail("Sample weights have overflowed to infinity");
 393 
 394     if (total == 0.0) fail("None of the given weights are nonzero");
 395 
 396     double inverse_average = (double)list.length / total;
 397 
 398     struct {
 399         int64_t alias;
 400         double odds;
 401     } aliases[list.length];
 402 
 403     for (int64_t i = 0; i < (int64_t)list.length; i++) {
 404         double weight = i >= (int64_t)weights.length ? 0.0 : *(double *)(weights.data + weights.stride * i);
 405         aliases[i].odds = weight * inverse_average;
 406         aliases[i].alias = -1;
 407     }
 408 
 409     int64_t small = 0;
 410     for (int64_t big = 0; big < (int64_t)list.length; big++) {
 411         while (aliases[big].odds >= 1.0) {
 412             while (small < (int64_t)list.length && (aliases[small].odds >= 1.0 || aliases[small].alias != -1))
 413                 ++small;
 414 
 415             if (small >= (int64_t)list.length) {
 416                 aliases[big].odds = 1.0;
 417                 aliases[big].alias = big;
 418                 break;
 419             }
 420 
 421             aliases[small].alias = big;
 422             aliases[big].odds = (aliases[small].odds + aliases[big].odds) - 1.0;
 423         }
 424         if (big < small) small = big;
 425     }
 426 
 427     for (int64_t i = small; i < (int64_t)list.length; i++)
 428         if (aliases[i].alias == -1) aliases[i].alias = i;
 429 
 430     typedef double (*rng_fn_t)(void *);
 431     rng_fn_t rng_fn = random_num.fn ? (rng_fn_t)random_num.fn : _default_random_num;
 432 
 433     List_t selected = {.data = list.atomic ? GC_MALLOC_ATOMIC((size_t)(n * padded_item_size))
 434                                            : GC_MALLOC((size_t)(n * padded_item_size)),
 435                        .length = (uint64_t)n,
 436                        .stride = padded_item_size,
 437                        .atomic = list.atomic};
 438     for (int64_t i = 0; i < n; i++) {
 439         double r = rng_fn(random_num.userdata);
 440         if unlikely (r < 0.0 || r >= 1.0)
 441             fail("The random number function returned a value not between 0.0 (inclusive) and 1.0 (exclusive): ", r);
 442         r *= (double)list.length;
 443         int64_t index = (int64_t)r;
 444         assert(index >= 0 && index < (int64_t)list.length);
 445         if ((r - (double)index) > aliases[index].odds) index = aliases[index].alias;
 446         memcpy(selected.data + i * selected.stride, list.data + index * list.stride, (size_t)padded_item_size);
 447     }
 448     return selected;
 449 }
 450 
 451 public
 452 List_t List$from(List_t list, Int_t first) {
 453     return List$slice(list, first, I_small(-1));
 454 }
 455 
 456 public
 457 List_t List$to(List_t list, Int_t last) {
 458     return List$slice(list, I_small(1), last);
 459 }
 460 
 461 public
 462 List_t List$by(List_t list, Int_t int_stride, int64_t padded_item_size) {
 463     int64_t stride = Int64$from_int(int_stride, false);
 464     // In the unlikely event that the stride value would be too large to fit in
 465     // a 15-bit integer, fall back to creating a copy of the list:
 466     if (unlikely(list.stride * stride < LIST_MIN_STRIDE || list.stride * stride > LIST_MAX_STRIDE)) {
 467         int64_t len = (stride < 0 ? (int64_t)list.length / -stride : (int64_t)list.length / stride)
 468                       + (((int64_t)list.length % stride) != 0);
 469         if (len <= 0) return list.atomic ? EMPTY_ATOMIC_LIST : EMPTY_LIST;
 470         void *copy = list.atomic ? GC_MALLOC_ATOMIC((size_t)(len * padded_item_size))
 471                                  : GC_MALLOC((size_t)(len * padded_item_size));
 472         void *start = (stride < 0 ? list.data + (list.stride * ((int64_t)list.length - 1)) : list.data);
 473         for (int64_t i = 0; i < len; i++)
 474             memcpy(copy + i * padded_item_size, start + list.stride * stride * i, (size_t)padded_item_size);
 475         return (List_t){
 476             .data = copy,
 477             .length = (uint64_t)len,
 478             .stride = padded_item_size,
 479             .atomic = list.atomic,
 480         };
 481     }
 482 
 483     if (stride == 0) return list.atomic ? EMPTY_ATOMIC_LIST : EMPTY_LIST;
 484 
 485     return (List_t){
 486         .atomic = list.atomic,
 487         .data = (stride < 0 ? list.data + (list.stride * ((int64_t)list.length - 1)) : list.data),
 488         .length = (uint64_t)((stride < 0 ? (int64_t)list.length / -stride : (int64_t)list.length / stride)
 489                              + (((int64_t)list.length % stride) != 0)),
 490         .stride = list.stride * stride,
 491         .data_refcount = list.data_refcount,
 492     };
 493 }
 494 
 495 public
 496 List_t List$slice(List_t list, Int_t int_first, Int_t int_last)
 497 
 498 {
 499     int64_t first = Int64$from_int(int_first, false);
 500     if (first < 0) first = (int64_t)list.length + first + 1;
 501 
 502     int64_t last = Int64$from_int(int_last, false);
 503     if (last < 0) last = (int64_t)list.length + last + 1;
 504 
 505     if (last > (int64_t)list.length) last = (int64_t)list.length;
 506 
 507     if (first < 1 || first > (int64_t)list.length || last == 0) return EMPTY_ATOMIC_LIST;
 508 
 509     return (List_t){
 510         .atomic = list.atomic,
 511         .data = list.data + list.stride * (first - 1),
 512         .length = (uint64_t)(last - first + 1),
 513         .stride = list.stride,
 514         .data_refcount = list.data_refcount,
 515     };
 516 }
 517 
 518 public
 519 List_t List$reversed(List_t list, int64_t padded_item_size) {
 520     // Just in case negating the stride gives a value that doesn't fit into a
 521     // 15-bit integer, fall back to List$by()'s more general method of copying
 522     // the list. This should only happen if list.stride is MIN_STRIDE to
 523     // begin with (very unlikely).
 524     if (unlikely(-list.stride < LIST_MIN_STRIDE || -list.stride > LIST_MAX_STRIDE))
 525         return List$by(list, I(-1), padded_item_size);
 526 
 527     List_t reversed = list;
 528     reversed.stride = -list.stride;
 529     reversed.data = list.data + ((int64_t)list.length - 1) * list.stride;
 530     return reversed;
 531 }
 532 
 533 public
 534 List_t List$concat(List_t x, List_t y, int64_t padded_item_size) {
 535     void *data = x.atomic ? GC_MALLOC_ATOMIC((size_t)(padded_item_size * (int64_t)(x.length + y.length)))
 536                           : GC_MALLOC((size_t)(padded_item_size * (int64_t)(x.length + y.length)));
 537     if (x.stride == padded_item_size) {
 538         memcpy(data, x.data, (size_t)(padded_item_size * (int64_t)x.length));
 539     } else {
 540         for (int64_t i = 0; i < (int64_t)x.length; i++)
 541             memcpy(data + i * padded_item_size, x.data + i * padded_item_size, (size_t)padded_item_size);
 542     }
 543 
 544     void *dest = data + padded_item_size * (int64_t)x.length;
 545     if (y.stride == padded_item_size) {
 546         memcpy(dest, y.data, (size_t)(padded_item_size * (int64_t)y.length));
 547     } else {
 548         for (int64_t i = 0; i < (int64_t)y.length; i++)
 549             memcpy(dest + i * padded_item_size, y.data + i * y.stride, (size_t)padded_item_size);
 550     }
 551 
 552     return (List_t){
 553         .data = data,
 554         .length = x.length + y.length,
 555         .stride = padded_item_size,
 556         .atomic = x.atomic,
 557     };
 558 }
 559 
 560 public
 561 bool List$has(List_t list, void *item, const TypeInfo_t *type) {
 562     const TypeInfo_t *item_type = type->ListInfo.item;
 563     for (int64_t i = 0; i < (int64_t)list.length; i++) {
 564         if (generic_equal(list.data + i * list.stride, item, item_type)) return true;
 565     }
 566     return false;
 567 }
 568 
 569 public
 570 void List$clear(List_t *list) {
 571     *list = list->atomic ? EMPTY_ATOMIC_LIST : EMPTY_LIST;
 572 }
 573 
 574 public
 575 int32_t List$compare(const void *vx, const void *vy, const TypeInfo_t *type) {
 576     const List_t *x = (List_t *)vx, *y = (List_t *)vy;
 577     // Early out for lists with the same data, e.g. two copies of the same list:
 578     if (x->data == y->data && x->stride == y->stride) return (x->length > y->length) - (x->length < y->length);
 579 
 580     const TypeInfo_t *item = type->ListInfo.item;
 581     if (item->tag == PointerInfo || !item->metamethods.compare) { // data comparison
 582         int64_t item_padded_size = type->ListInfo.item->size;
 583         if (type->ListInfo.item->align > 1 && item_padded_size % type->ListInfo.item->align)
 584             errx(1, "Item size is not padded!");
 585 
 586         if ((int64_t)x->stride == item_padded_size && (int64_t)y->stride == item_padded_size
 587             && item->size == item_padded_size) {
 588             int32_t cmp = (int32_t)memcmp(x->data, y->data,
 589                                           (size_t)(MIN((int64_t)x->length, (int64_t)y->length) * item_padded_size));
 590             if (cmp != 0) return cmp;
 591         } else {
 592             for (int32_t i = 0, len = MIN(x->length, y->length); i < len; i++) {
 593                 int32_t cmp = (int32_t)memcmp(x->data + x->stride * i, y->data + y->stride * i, (size_t)(item->size));
 594                 if (cmp != 0) return cmp;
 595             }
 596         }
 597     } else {
 598         for (int32_t i = 0, len = MIN(x->length, y->length); i < len; i++) {
 599             int32_t cmp = generic_compare(x->data + x->stride * i, y->data + y->stride * i, item);
 600             if (cmp != 0) return cmp;
 601         }
 602     }
 603     return (x->length > y->length) - (x->length < y->length);
 604 }
 605 
 606 public
 607 bool List$equal(const void *x, const void *y, const TypeInfo_t *type) {
 608     return x == y || (((List_t *)x)->length == ((List_t *)y)->length && List$compare(x, y, type) == 0);
 609 }
 610 
 611 public
 612 Text_t List$as_text(const void *obj, bool colorize, const TypeInfo_t *type) {
 613     List_t *list = (List_t *)obj;
 614     if (!list) return Text$concat(Text("["), generic_as_text(NULL, false, type->ListInfo.item), Text("]"));
 615 
 616     const TypeInfo_t *item_type = type->ListInfo.item;
 617     Text_t text = Text("[");
 618     for (int64_t i = 0; i < (int64_t)list->length; i++) {
 619         if (i > 0) text = Text$concat(text, Text(", "));
 620         Text_t item_text = generic_as_text(list->data + i * list->stride, colorize, item_type);
 621         text = Text$concat(text, item_text);
 622     }
 623     text = Text$concat(text, Text("]"));
 624     return text;
 625 }
 626 
 627 public
 628 uint64_t List$hash(const void *obj, const TypeInfo_t *type) {
 629     const List_t *list = (List_t *)obj;
 630     const TypeInfo_t *item = type->ListInfo.item;
 631     siphash sh;
 632     siphashinit(&sh, sizeof(uint64_t[list->length]));
 633     if (item->tag == PointerInfo || (!item->metamethods.hash && item->size == sizeof(void *))) { // Raw data hash
 634         for (int64_t i = 0; i < (int64_t)list->length; i++)
 635             siphashadd64bits(&sh, (uint64_t)(list->data + i * list->stride));
 636     } else {
 637         for (int64_t i = 0; i < (int64_t)list->length; i++) {
 638             uint64_t item_hash = generic_hash(list->data + i * list->stride, item);
 639             siphashadd64bits(&sh, item_hash);
 640         }
 641     }
 642     return siphashfinish_last_part(&sh, 0);
 643 }
 644 
 645 static void siftdown(List_t *heap, int64_t startpos, int64_t pos, Closure_t comparison, int64_t padded_item_size) {
 646     assert(pos > 0 && pos < (int64_t)heap->length);
 647     char newitem[padded_item_size];
 648     memcpy(newitem, heap->data + heap->stride * pos, (size_t)(padded_item_size));
 649     while (pos > startpos) {
 650         int64_t parentpos = (pos - 1) >> 1;
 651         typedef int32_t (*cmp_fn_t)(void *, void *, void *);
 652         int32_t cmp = ((cmp_fn_t)comparison.fn)(newitem, heap->data + heap->stride * parentpos, comparison.userdata);
 653         if (cmp >= 0) break;
 654 
 655         memcpy(heap->data + heap->stride * pos, heap->data + heap->stride * parentpos, (size_t)(padded_item_size));
 656         pos = parentpos;
 657     }
 658     memcpy(heap->data + heap->stride * pos, newitem, (size_t)(padded_item_size));
 659 }
 660 
 661 static void siftup(List_t *heap, int64_t pos, Closure_t comparison, int64_t padded_item_size) {
 662     int64_t endpos = (int64_t)heap->length;
 663     int64_t startpos = pos;
 664     assert(pos < endpos);
 665 
 666     char old_top[padded_item_size];
 667     memcpy(old_top, heap->data + heap->stride * pos, (size_t)(padded_item_size));
 668     // Bubble up the smallest leaf node
 669     int64_t limit = endpos >> 1;
 670     while (pos < limit) {
 671         int64_t childpos = 2 * pos + 1; // Smaller of the two child nodes
 672         if (childpos + 1 < endpos) {
 673             typedef int32_t (*cmp_fn_t)(void *, void *, void *);
 674             int32_t cmp = ((cmp_fn_t)comparison.fn)(heap->data + heap->stride * childpos,
 675                                                     heap->data + heap->stride * (childpos + 1), comparison.userdata);
 676             childpos += (cmp >= 0);
 677         }
 678 
 679         // Move the child node up:
 680         memcpy(heap->data + heap->stride * pos, heap->data + heap->stride * childpos, (size_t)(padded_item_size));
 681         pos = childpos;
 682     }
 683     memcpy(heap->data + heap->stride * pos, old_top, (size_t)(padded_item_size));
 684     // Shift the node's parents down:
 685     siftdown(heap, startpos, pos, comparison, padded_item_size);
 686 }
 687 
 688 public
 689 void List$heap_push(List_t *heap, const void *item, Closure_t comparison, int64_t padded_item_size) {
 690     List$insert(heap, item, I(0), padded_item_size);
 691 
 692     if (heap->length > 1) {
 693         if (heap->data_refcount != 0) List$compact(heap, padded_item_size);
 694         siftdown(heap, 0, (int64_t)heap->length - 1, comparison, padded_item_size);
 695     }
 696 }
 697 
 698 public
 699 void List$heap_pop(List_t *heap, Closure_t comparison, int64_t padded_item_size) {
 700     if (heap->length == 0) fail("Attempt to pop from an empty list");
 701 
 702     if (heap->length == 1) {
 703         *heap = EMPTY_LIST;
 704     } else if (heap->length == 2) {
 705         heap->data += heap->stride;
 706         --heap->length;
 707     } else {
 708         if (heap->data_refcount != 0) List$compact(heap, padded_item_size);
 709         memcpy(heap->data, heap->data + heap->stride * ((int64_t)heap->length - 1), (size_t)(padded_item_size));
 710         --heap->length;
 711         siftup(heap, 0, comparison, padded_item_size);
 712     }
 713 }
 714 
 715 public
 716 void List$heapify(List_t *heap, Closure_t comparison, int64_t padded_item_size) {
 717     if (heap->data_refcount != 0) List$compact(heap, padded_item_size);
 718 
 719     // It's necessary to bump the refcount because the user's comparison
 720     // function could do stuff that modifies the heap's data.
 721     LIST_INCREF(*heap);
 722     int64_t i, n = (int64_t)heap->length;
 723     for (i = (n >> 1) - 1; i >= 0; i--)
 724         siftup(heap, i, comparison, padded_item_size);
 725     LIST_DECREF(*heap);
 726 }
 727 
 728 public
 729 Int_t List$binary_search(List_t list, void *target, Closure_t comparison) {
 730     typedef int32_t (*cmp_fn_t)(void *, void *, void *);
 731     int64_t lo = 0, hi = (int64_t)list.length - 1;
 732     while (lo <= hi) {
 733         int64_t mid = (lo + hi) / 2;
 734         int32_t cmp = ((cmp_fn_t)comparison.fn)(list.data + list.stride * mid, target, comparison.userdata);
 735         if (cmp == 0) return I(mid + 1);
 736         else if (cmp < 0) lo = mid + 1;
 737         else if (cmp > 0) hi = mid - 1;
 738     }
 739     return I(lo + 1); // Return the index where the target would be inserted
 740 }
 741 
 742 public
 743 PUREFUNC bool List$is_none(const void *obj, const TypeInfo_t *info) {
 744     (void)info;
 745     return ((List_t *)obj)->data == NULL;
 746 }
 747 
 748 public
 749 void List$serialize(const void *obj, FILE *out, Table_t *pointers, const TypeInfo_t *type) {
 750     List_t list = *(List_t *)obj;
 751     int64_t len = (int64_t)list.length;
 752     Int64$serialize(&len, out, pointers, &Int64$info);
 753     serialize_fn_t item_serialize = type->ListInfo.item->metamethods.serialize;
 754     if (item_serialize) {
 755         for (int64_t i = 0; i < len; i++)
 756             item_serialize(list.data + i * list.stride, out, pointers, type->ListInfo.item);
 757     } else if (list.stride == type->ListInfo.item->size) {
 758         fwrite(list.data, (size_t)type->ListInfo.item->size, (size_t)len, out);
 759     } else {
 760         for (int64_t i = 0; i < len; i++)
 761             fwrite(list.data + i * list.stride, (size_t)type->ListInfo.item->size, 1, out);
 762     }
 763 }
 764 
 765 public
 766 void List$deserialize(FILE *in, void *obj, List_t *pointers, const TypeInfo_t *type) {
 767     int64_t len = -1;
 768     Int64$deserialize(in, &len, pointers, &Int64$info);
 769     int64_t padded_size = type->ListInfo.item->size;
 770     if (type->ListInfo.item->align > 0 && padded_size % type->ListInfo.item->align > 0)
 771         padded_size += type->ListInfo.item->align - (padded_size % type->ListInfo.item->align);
 772     List_t list = {
 773         .length = (uint64_t)len,
 774         .data = GC_MALLOC((size_t)(len * padded_size)),
 775         .stride = padded_size,
 776     };
 777     deserialize_fn_t item_deserialize = type->ListInfo.item->metamethods.deserialize;
 778     if (item_deserialize) {
 779         for (int64_t i = 0; i < len; i++)
 780             item_deserialize(in, list.data + i * list.stride, pointers, type->ListInfo.item);
 781     } else if (list.stride == type->ListInfo.item->size) {
 782         if (fread(list.data, (size_t)type->ListInfo.item->size, (size_t)len, in) != (size_t)len)
 783             fail("Not enough data in stream to deserialize");
 784     } else {
 785         size_t item_size = (size_t)type->ListInfo.item->size;
 786         for (int64_t i = 0; i < len; i++) {
 787             if (fread(list.data + i * list.stride, item_size, 1, in) != 1)
 788                 fail("Not enough data in stream to deserialize");
 789         }
 790     }
 791     *(List_t *)obj = list;
 792 }