cgit.sxemacs.org Git - sxemacs/blob - src/map.c

   1 /*** map.c -- Maps
   2  *
   3  * Copyright (C) 2007 Sebastian Freundt
   4  *
   5  * Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6  *
   7  * This file is part of SXEmacs.
   8  *
   9  * Redistribution and use in source and binary forms, with or without
  10  * modification, are permitted provided that the following conditions
  11  * are met:
  12  *
  13  * 1. Redistributions of source code must retain the above copyright
  14  *    notice, this list of conditions and the following disclaimer.
  15  *
  16  * 2. Redistributions in binary form must reproduce the above copyright
  17  *    notice, this list of conditions and the following disclaimer in the
  18  *    documentation and/or other materials provided with the distribution.
  19  *
  20  * 3. Neither the name of the author nor the names of any contributors
  21  *    may be used to endorse or promote products derived from this
  22  *    software without specific prior written permission.
  23  *
  24  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27  * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34  * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35  *
  36  ***
  37  * Comment:
  38  * All the code below is just a first (tacky) draught.  It is optimised
  39  * in a way, but still, the ardent worshippers of the DRY principle
  40  * would tar and feather me for that.
  41  *
  42  ***/
  43
  44 /* Synched up with: Not in FSF, not in XE */
  45
  46 #include <sxemacs.h>
  47 #include "map.h"
  48 #include "dict.h"
  49 #include "skiplist.h"
  50 #include "ent/ent.h"
  51
  52 Lisp_Object Qmap;
  53 Lisp_Object Q_arity, Q_result_type, Q_mode, Q_glue;
  54 Lisp_Object Q_separator, Q_initiator, Q_terminator;
  55 Lisp_Object Qpntw, Qpointwise, Qpoints;
  56 Lisp_Object Qkeyw, Qkeywise, Qkeys;
  57 Lisp_Object Qcomb, Qcombination, Qcombinations;
  58 Lisp_Object Qperm, Qpermutation, Qpermutations;
  59 Lisp_Object Qcart, Qcartesian;
  60
  61 typedef Lisp_Object(*glue_f)(int nargs, Lisp_Object *args);
  62
  63 static Lisp_Object Qinplace, Qlitter, Qconcat;
  64 static Lisp_Object Qvector, Qbit_vector;
  65
  66 EXFUN(Fstring, MANY);
  67 EXFUN(Fbit_vector, MANY);
  68
  69 /* until this is available globally */
  70 #define DICTP(x)        (HASH_TABLEP(x) || SKIPLISTP(x))
  71
  72 struct decoration_s {
  73         Lisp_Object ini, ter, sep;
  74 };
  75
  76 \f
  77 /* auxiliary */
  78 static inline Lisp_Object
  79 __Flist(int nargs, Lisp_Object *args)
  80         __attribute__((always_inline));
  81 static inline Lisp_Object
  82 __Flist(int nargs, Lisp_Object *args)
  83 {
  84         /* this is just Flist() but inlined */
  85         Lisp_Object val = Qnil;
  86         Lisp_Object *argp = args + nargs;
  87
  88         while (argp > args)
  89                 val = Fcons(*--argp, val);
  90         return val;
  91 }
  92
  93 static long unsigned int
  94 __ncombinations(register long unsigned int n, long unsigned int k)
  95 {
  96 /* == binomial(n, k) */
  97         if (UNLIKELY(n == k || k == 0)) {
  98                 return 1UL;
  99         } else if (UNLIKELY(k == 1 || n - k == 1)) {
 100                 return n;
 101         } else if (k == 2 || n - k == 2) {
 102                 return (n * (n-1)) >> 1;
 103         } else {
 104                 /* otherwise do the hard work */
 105                 long unsigned int num = n*(n-1)*(n-k+1), den = k*(k-1);
 106
 107                 /* swap k if necessary */
 108                 if (n - k < k) {
 109                         k = n - k;
 110                 }
 111
 112                 for (n -= 2, k -= 2; k > 1;) {
 113                         num *= n--;
 114                         den *= k--;
 115                 }
 116                 return num/den;
 117         }
 118 }
 119
 120 static long unsigned int
 121 __factorial(register long unsigned int n)
 122 {
 123         register long unsigned int r = n;
 124
 125         /* trivial cases first */
 126         switch (n) {
 127         case 0:
 128         case 1:
 129                 return 1UL;
 130         case 2:
 131                 return 2UL;
 132         case 3:
 133                 return 6UL;
 134         case 4:
 135                 return 24UL;
 136         case 5:
 137                 return 120UL;
 138         case 6:
 139                 return 720UL;
 140         case 7:
 141                 return 5040UL;
 142         case 8:
 143                 return 40320UL;
 144         default:
 145                 r = 40320UL * n;
 146         }
 147
 148         /* the loop */
 149         for (long unsigned int i = 9; i < n; i++) {
 150                 r *= i;
 151         }
 152         return r;
 153 }
 154
 155 static long unsigned int
 156 __nvariations(register long unsigned int n, long unsigned int k)
 157 {
 158 /* == binomial(n, k) * factorial(k) */
 159         if (UNLIKELY(k == 0)) {
 160                 return 1UL;
 161         } else if (UNLIKELY(k == n)) {
 162                 return __factorial(k);
 163         } else if (UNLIKELY(k == 1)) {
 164                 return n;
 165         } else if (UNLIKELY(n - k == 1)) {
 166                 return __factorial(n);
 167         } else if (k == 2) {
 168                 return n * (n-1);
 169         } else if (k == 3) {
 170                 return n * (n-1) * (n-2);
 171         } else {
 172                 /* otherwise do the hard work */
 173                 long unsigned int num = n--;
 174
 175                 num *= n--;
 176                 num *= n--;
 177                 num *= n--;
 178                 while (k-- > 4) {
 179                         num *= n--;
 180                 }
 181                 return num;
 182         }
 183 }
 184
 185 static long unsigned int
 186 __ncart(register long unsigned int n, long unsigned int k)
 187 {
 188 /* == n^k */
 189         long unsigned int res;
 190
 191         switch (k) {
 192         case 2:
 193                 return n*n;
 194         case 3:
 195                 return n*n*n;
 196         case 1:
 197                 return n;
 198         case 0:
 199                 return 1UL;
 200         default:
 201                 break;
 202         }
 203
 204         for (res = n * n * n * n, k -= 4; k > 0; k--) {
 205                 res *= n;
 206         }
 207         return res;
 208 }
 209
 210
 211 static inline void
 212 __advance_multi_index()
 213         __attribute__((always_inline));
 214 static inline void
 215 __advance_multi_index(long int idx[], long int j, long int fam_len)
 216 {
 217         /* partially unroll */
 218         if (LIKELY(++idx[--j] < fam_len)) {
 219                 return;
 220         }
 221         idx[j] = 0;
 222         if (LIKELY(++idx[--j] < fam_len)) {
 223                 return;
 224         }
 225         idx[j] = 0;
 226         if (LIKELY(++idx[--j] < fam_len)) {
 227                 return;
 228         }
 229         idx[j] = 0;
 230         while (j > 0) {
 231                 if (LIKELY(++idx[--j] < fam_len)) {
 232                         return;
 233                 }
 234                 idx[j] = 0;
 235         }
 236         return;
 237 }
 238
 239 static inline void
 240 __advance_multi_index_2()
 241         __attribute__((always_inline));
 242 static inline void
 243 __advance_multi_index_2(long int idx[], long int j, size_t flen[])
 244 {
 245 /* improved version of __a_m_v() which allows for differently-sized families */
 246         /* partially unroll */
 247         if (LIKELY((--j, ++idx[j] < (long int)flen[j]))) {
 248                 return;
 249         }
 250         idx[j] = 0;
 251         if (LIKELY((--j, ++idx[j] < (long int)flen[j]))) {
 252                 return;
 253         }
 254         idx[j] = 0;
 255         if (LIKELY((--j, ++idx[j] < (long int)flen[j]))) {
 256                 return;
 257         }
 258         idx[j] = 0;
 259         while (j > 0) {
 260                 if (LIKELY((--j, ++idx[j] < (long int)flen[j]))) {
 261                         return;
 262                 }
 263                 idx[j] = 0;
 264         }
 265         return;
 266 }
 267
 268 static inline void
 269 __advance_multi_index_3()
 270         __attribute__((always_inline));
 271 static inline void
 272 __advance_multi_index_3(
 273         long int idx[], long int j, size_t flen[],
 274         long int nseqs, size_t arity[])
 275 {
 276 /* improved version of __a_m_v_2() which allows for differently-sized families
 277  * and multiplicities thereof
 278  * this is for cartesian indexing, i.e. the order goes
 279  * [1,0]->[1,1]->[1,2]->[2,0] for arity (., 3) */
 280         long int mlt = arity[--nseqs];
 281
 282         if (LIKELY(++idx[--j] < (long int)flen[nseqs])) {
 283                 return;
 284         }
 285         idx[j] = 0;
 286         if (mlt-- == 0) {
 287                 mlt = arity[--nseqs];
 288         }
 289         if (LIKELY(++idx[--j] < (long int)flen[nseqs])) {
 290                 return;
 291         }
 292         idx[j] = 0;
 293         if (mlt-- == 0) {
 294                 mlt = arity[--nseqs];
 295         }
 296         if (LIKELY(++idx[--j] < (long int)flen[nseqs])) {
 297                 return;
 298         }
 299         idx[j] = 0;
 300         if (mlt-- == 0) {
 301                 mlt = arity[--nseqs];
 302         }
 303         while (j > 0 && nseqs >= 0) {
 304                 if (LIKELY(++idx[--j] < (long int)flen[nseqs])) {
 305                         return;
 306                 }
 307                 idx[j] = 0;
 308                 if (mlt-- == 0) {
 309                         mlt = arity[--nseqs];
 310                 }
 311         }
 312         return;
 313 }
 314
 315 static inline void
 316 __initialise_multi_index()
 317         __attribute__((always_inline));
 318 static inline void
 319 __initialise_multi_index(size_t midx[], size_t arity)
 320 {
 321         midx[0] = 0L;
 322         for (size_t j = 1; j < arity; j++) {
 323                 midx[j] = j;
 324         }
 325         return;
 326 }
 327
 328 static inline bool
 329 __advance_multi_index_comb()
 330         __attribute__((always_inline));
 331 static inline bool
 332 __advance_multi_index_comb(size_t idx[], size_t len, int arity)
 333 {
 334         register long int i;
 335
 336         for (i = arity-1; (i >= 0) && idx[i] >= len - arity + i; i--);
 337         idx[i]++;
 338         for (; ++i < arity; ) {
 339                 idx[i] = idx[i-1]+1;
 340         }
 341         return (idx[i-1] < len);
 342 }
 343
 344 static inline void
 345 __advance_multi_index_4()
 346         __attribute__((always_inline));
 347 static inline void
 348 __advance_multi_index_4(
 349         size_t *midx[], size_t flen[], long int j /*nseqs*/, size_t arity[])
 350 {
 351 /* like __a_m_v_3(), also allowing for differently-sized families
 352  * and multiplicities thereof, but for for combinatorial indexing,
 353  * i.e. the order goes
 354  * [1,2]->[1,3]->[2,3] for arity (., 3) */
 355         --j;
 356         if (LIKELY(__advance_multi_index_comb(midx[j], flen[j], arity[j]))) {
 357                 /* if there's more to come, bingo */
 358                 return;
 359         }
 360         /* otherwise reinitialise the mindex we're currently shagging */
 361         __initialise_multi_index(midx[j], arity[j]);
 362
 363         --j;
 364         if (LIKELY(__advance_multi_index_comb(midx[j], flen[j], arity[j]))) {
 365                 return;
 366         }
 367         /* otherwise reinitialise the mindex we're currently shagging */
 368         __initialise_multi_index(midx[j], arity[j]);
 369
 370         /* now loop mode */
 371         while (j-- > 0) {
 372                 if (LIKELY(__advance_multi_index_comb(
 373                                    midx[j], flen[j], arity[j]))) {
 374                         return;
 375                 }
 376                 /* otherwise reinitialise the mindex we're currently shagging */
 377                 __initialise_multi_index(midx[j], arity[j]);
 378         }
 379         return;
 380 }
 381
 382 \f
 383 /* This is the guts of several mapping functions.
 384    Apply FUNCTION to each element of SEQUENCE, one by one,
 385    storing the results into elements of VALS, a C vector of Lisp_Objects.
 386    LENI is the length of VALS, which should also be the length of SEQUENCE.
 387
 388    If VALS is a null pointer, do not accumulate the results. */
 389
 390 static void
 391 mapcar1(size_t leni, Lisp_Object * vals,
 392         Lisp_Object function, Lisp_Object sequence)
 393 {
 394         Lisp_Object result;
 395         Lisp_Object args[2];
 396         struct gcpro gcpro1;
 397
 398         args[0] = function;
 399
 400         if (vals) {
 401                 /* clean sweep */
 402                 memset(vals, 0, leni * sizeof(Lisp_Object));
 403                 GCPROn(vals, leni);
 404         }
 405
 406         if (LISTP(sequence)) {
 407                 /* A devious `function' could either:
 408                    - insert garbage into the list in front of us, causing XCDR to crash
 409                    - amputate the list behind us using (setcdr), causing the remaining
 410                    elts to lose their GCPRO status.
 411
 412                    if (vals != 0) we avoid this by copying the elts into the
 413                    `vals' array.  By a stroke of luck, `vals' is exactly large
 414                    enough to hold the elts left to be traversed as well as the
 415                    results computed so far.
 416
 417                    if (vals == 0) we don't have any free space available and
 418                    don't want to eat up any more stack with alloca().
 419                    So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */
 420
 421                 if (vals) {
 422                         Lisp_Object *val = vals;
 423                         size_t i;
 424
 425                         LIST_LOOP_2(elt, sequence) {
 426                             *val++ = elt;
 427                         }
 428
 429                         for (i = 0; i < leni; i++) {
 430                                 args[1] = vals[i];
 431                                 vals[i] = Ffuncall(2, args);
 432                         }
 433                 } else {
 434                         Lisp_Object elt, tail;
 435                         EMACS_INT len_unused;
 436                         struct gcpro ngcpro1;
 437
 438                         NGCPRO1(tail);
 439
 440                         {
 441                                 EXTERNAL_LIST_LOOP_4_NO_DECLARE(elt, sequence,
 442                                                                 tail,
 443                                                                 len_unused) {
 444                                         args[1] = elt;
 445                                         Ffuncall(2, args);
 446                                 }
 447                         }
 448
 449                         NUNGCPRO;
 450                 }
 451         } else if (VECTORP(sequence)) {
 452                 Lisp_Object *objs = XVECTOR_DATA(sequence);
 453
 454                 for (size_t i = 0; i < leni; i++) {
 455                         args[1] = *objs++;
 456                         result = Ffuncall(2, args);
 457                         if (vals) {
 458                                 vals[i] = result;
 459                         }
 460                 }
 461         } else if (DLLISTP(sequence)) {
 462                 dllist_item_t elt = XDLLIST_FIRST(sequence);
 463
 464                 for (size_t i = 0; elt; i++) {
 465                         args[1] = (Lisp_Object)elt->item;
 466                         result = Ffuncall(2, args);
 467                         if (vals) {
 468                                 vals[i] = result;
 469                         }
 470                         elt = elt->next;
 471                 }
 472         } else if (STRINGP(sequence)) {
 473                 /* The string data of `sequence' might be relocated during GC. */
 474                 Bytecount slen = XSTRING_LENGTH(sequence);
 475                 Bufbyte *p = NULL;
 476                 Bufbyte *end = NULL;
 477                 int speccount = specpdl_depth();
 478                 size_t i = 0;
 479
 480                 XMALLOC_ATOMIC_OR_ALLOCA(p, slen, Bufbyte);
 481                 end = p + slen;
 482
 483                 memcpy(p, XSTRING_DATA(sequence), slen);
 484
 485                 while (p < end) {
 486                         args[1] = make_char(charptr_emchar(p));
 487                         INC_CHARPTR(p);
 488                         result = Ffuncall(2, args);
 489                         if (vals) {
 490                                 vals[i++] = result;
 491                         }
 492                 }
 493                 XMALLOC_UNBIND(p, slen, speccount);
 494         } else if (BIT_VECTORP(sequence)) {
 495                 Lisp_Bit_Vector *v = XBIT_VECTOR(sequence);
 496
 497                 for (size_t i = 0; i < leni; i++) {
 498                         args[1] = make_int(bit_vector_bit(v, i));
 499                         result = Ffuncall(2, args);
 500                         if (vals) {
 501                                 vals[i] = result;
 502                         }
 503                 }
 504         } else {
 505                 /* unreachable, since Flength (sequence) did not get an error */
 506                 abort();
 507         }
 508
 509         if (vals) {
 510                 UNGCPRO;
 511         }
 512 }
 513
 514 static void
 515 list_map_inplace(Lisp_Object function, Lisp_Object list)
 516 {
 517         Lisp_Object args[2];
 518         struct gcpro gcpro1, gcpro2;
 519         Lisp_Object elt = list;
 520
 521         GCPRO2(function, list);
 522
 523         args[0] = function;
 524         while (!NILP(elt)) {
 525                 args[1] = XCAR(elt);
 526                 XCAR(elt) = Ffuncall(2, args);
 527                 elt = XCDR(elt);
 528         }
 529         UNGCPRO;
 530 }
 531
 532 static void
 533 vector_map_inplace(Lisp_Object function, Lisp_Object tuple)
 534 {
 535         Lisp_Object *objs = XVECTOR_DATA(tuple);
 536         Lisp_Object args[2];
 537         size_t i, len = XVECTOR_LENGTH(tuple);
 538         struct gcpro gcpro1, gcpro2, gcpro3;
 539
 540         GCPRO2n(function, tuple, args, countof(args));
 541
 542         args[0] = function;
 543         for (i = 0; i < len; i++) {
 544                 args[1] = *objs;
 545                 *objs++ = Ffuncall(2, args);
 546         }
 547
 548         UNGCPRO;
 549 }
 550
 551 static void
 552 string_map_inplace(Lisp_Object function, Lisp_Object string)
 553 {
 554         Lisp_Object args[2];
 555         size_t len = XSTRING_LENGTH(string);
 556         Bufbyte *p = XSTRING_DATA(string);
 557         Bufbyte *end = p + len;
 558         struct gcpro gcpro1, gcpro2, gcpro3;
 559
 560         GCPRO2n(function, string, args, countof(args));
 561
 562         args[0] = function;
 563         while (p < end) {
 564                 args[1] = make_char(charptr_emchar(p));
 565                 args[1] = Ffuncall(2, args);
 566                 if (CHARP(args[1]))
 567                         set_charptr_emchar(p, XCHAR(args[1]));
 568                 else
 569                         set_charptr_emchar(p, '\000');
 570                 INC_CHARPTR(p);
 571         }
 572
 573         UNGCPRO;
 574 }
 575
 576 static void
 577 bit_vector_map_inplace(Lisp_Object function, Lisp_Object bitvec)
 578 {
 579         Lisp_Bit_Vector *v = XBIT_VECTOR(bitvec);
 580         Lisp_Object args[2];
 581         struct gcpro gcpro1, gcpro2, gcpro3;
 582         size_t i, len = bit_vector_length(XBIT_VECTOR(bitvec));
 583
 584         GCPRO2n(function, bitvec, args, countof(args));
 585
 586         args[0] = function;
 587         for (i = 0; i < len; i++) {
 588                 args[1] = make_int(bit_vector_bit(v, i));
 589                 args[1] = Ffuncall(2, args);
 590                 if ((NUMBERP(args[1]) && ent_unrel_zerop(args[1])) ||
 591                     NILP(args[1]))
 592                         set_bit_vector_bit(v, i, 0);
 593                 else
 594                         set_bit_vector_bit(v, i, -1);
 595         }
 596
 597         UNGCPRO;
 598 }
 599
 600 /***
 601  * The mapfam approach
 602  */
 603
 604 /* auxiliary stuff */
 605 static inline size_t
 606 __fam_size(Lisp_Object fam)
 607 {
 608         return seq_length((seq_t)(void*)fam);
 609 }
 610
 611 static inline size_t
 612 __nfam_min_size(Lisp_Object fam[], size_t nfam)
 613 {
 614         size_t res;
 615
 616         /* catch the horst-case */
 617         if (UNLIKELY(nfam == 0)) {
 618                 return 0UL;
 619         }
 620         /* otherwise unroll a little */
 621         res = __fam_size(fam[0]);
 622         for (size_t j = 1; j < nfam; j++) {
 623                 size_t tmp = __fam_size(fam[j]);
 624                 if (tmp < res) {
 625                         res = tmp;
 626                 }
 627         }
 628         return res;
 629 }
 630
 631 static inline size_t
 632 __nfam_min_size_a(Lisp_Object fam[], size_t nfam, size_t arity[])
 633 {
 634         size_t res;
 635
 636         /* catch the horst-case */
 637         if (UNLIKELY(nfam == 0)) {
 638                 return 0UL;
 639         }
 640         /* otherwise unroll a little */
 641         res = __fam_size(fam[0]) / arity[0];
 642         for (size_t j = 1; j < nfam; j++) {
 643                 size_t tmp = __fam_size(fam[j]) / arity[j];
 644                 if (tmp < res) {
 645                         res = tmp;
 646                 }
 647         }
 648         return res;
 649 }
 650
 651 static inline size_t
 652 __nfam_cart_sum_size(size_t *sum, size_t *cart, size_t nfsz[],
 653                      Lisp_Object fam[], size_t nfam)
 654 {
 655 /* computes the size of the cartesian set and the maximum size of
 656  * the union set, returns the sum of cartesian and union, and puts
 657  * intermediately computed family sizes int nfsz */
 658
 659         /* catch the horst-case */
 660         if (UNLIKELY(nfam == 0)) {
 661                 *sum = *cart = 0;
 662                 return 0UL;
 663         } else if (nfam == 1) {
 664                 /* another horst case
 665                  * just 1 fam should always call fam_size() */
 666                 return *sum = *cart = nfsz[0] = __fam_size(fam[0]);
 667         }
 668         /* otherwise unroll a little */
 669         nfsz[0] = __fam_size(fam[0]);
 670         nfsz[1] = __fam_size(fam[1]);
 671         *sum = nfsz[0] + nfsz[1];
 672         *cart = nfsz[0] * nfsz[1];
 673         for (size_t j = 2; j < nfam; j++) {
 674                 nfsz[j] = __fam_size(fam[j]);
 675                 *sum += nfsz[j];
 676                 *cart *= nfsz[j];
 677         }
 678         return *sum + *cart;
 679 }
 680
 681 static inline void
 682 __my_pow_insitu(size_t *base, size_t expon)
 683 {
 684 /* improve me and put me somewhere else, ase-arith.h? */
 685         for (size_t i = 1, b = *base; i < expon; i++) {
 686                 *base *= b;
 687         }
 688         return;
 689 }
 690
 691 static inline size_t
 692 __my_pow_explicit(size_t base, size_t expon)
 693 {
 694 /* improve me and put me somewhere else, ase-arith.h? */
 695         size_t res = base;
 696         for (size_t i = 1; i < expon; i++) {
 697                 res *= base;
 698         }
 699         return res;
 700 }
 701
 702 static inline size_t
 703 __nfam_cart_sum_size_a(size_t *sum, size_t *cart, size_t *midxsz,
 704                        size_t nfsz[],
 705                        Lisp_Object fam[], size_t nfam, size_t arity[])
 706 {
 707 /* computes the size of the cartesian set (put into *cart), the maximum
 708  * size of the union set (returned) and the multiplicity of the
 709  * multi-index (which is the cross sum of the arity array) returns the
 710  * sum of cartesian and union, and puts intermediately computed family
 711  * sizes into nfsz */
 712
 713         /* catch the horst-case */
 714         if (UNLIKELY(nfam == 0)) {
 715                 *sum = *cart = *midxsz = 0;
 716                 return 0UL;
 717         } else if (nfam == 1) {
 718                 /* another horst case
 719                  * just 1 fam should always call fam_size() */
 720                 *sum = *cart = nfsz[0] = __fam_size(fam[0]);
 721                 __my_pow_insitu(cart, *midxsz = arity[0]);
 722                 return *sum + *cart;
 723         }
 724         /* otherwise unroll a little */
 725         nfsz[0] = __fam_size(fam[0]);
 726         nfsz[1] = __fam_size(fam[1]);
 727         *sum = nfsz[0] + nfsz[1];
 728         *midxsz = arity[0] + arity[1];
 729         *cart = __my_pow_explicit(nfsz[0], arity[0]) *
 730                 __my_pow_explicit(nfsz[1], arity[1]);
 731         for (size_t j = 2; j < nfam; j++) {
 732                 nfsz[j] = __fam_size(fam[j]);
 733                 *sum += nfsz[j];
 734                 *midxsz += arity[j];
 735                 *cart *= __my_pow_explicit(nfsz[j], arity[j]);
 736         }
 737         return *sum + *cart;
 738 }
 739
 740 static inline size_t
 741 __nfam_comb_sum_size_a(size_t *sum, size_t *comb, size_t *midxsz,
 742                        size_t nfsz[],
 743                        Lisp_Object fam[], size_t nfam, size_t arity[])
 744 {
 745 /* computes the size of the cartesian set (returned), the maximum size of
 746  * the union set and the multiplicity of the multi-index (which is the
 747  * cross sum of the arity array) returns the sum of cartesian and union,
 748  * and puts intermediately computed family sizes into nfsz */
 749
 750         /* catch the horst-case */
 751         if (UNLIKELY(nfam == 0)) {
 752                 *sum = *comb = *midxsz = 0;
 753                 return 0UL;
 754         } else if (nfam == 1) {
 755                 /* another horst case
 756                  * just 1 fam should always call fam_size() */
 757                 *sum = nfsz[0] = __fam_size(fam[0]);
 758                 *comb = __ncombinations(nfsz[0], *midxsz = arity[0]);
 759                 return *sum + *comb;
 760         }
 761         /* otherwise unroll a little */
 762         nfsz[0] = __fam_size(fam[0]);
 763         nfsz[1] = __fam_size(fam[1]);
 764         *sum = nfsz[0] + nfsz[1];
 765         *midxsz = arity[0] + arity[1];
 766         *comb = __ncombinations(nfsz[0], arity[0]) *
 767                 __ncombinations(nfsz[1], arity[1]);
 768         for (size_t j = 2; j < nfam; j++) {
 769                 nfsz[j] = __fam_size(fam[j]);
 770                 *sum += nfsz[j];
 771                 *midxsz += arity[j];
 772                 *comb *= __ncombinations(nfsz[j], arity[j]);
 773         }
 774         return *sum + *comb;
 775 }
 776
 777 static inline size_t
 778 __nfam_perm_sum_size(size_t *sum, size_t *cart, size_t *perm, size_t nfsz[],
 779                      Lisp_Object fam[], size_t nfam)
 780 {
 781 /* computes the size of the cartesian set and the maximum size of
 782  * the union set, returns the sum of cartesian and union, and puts
 783  * intermediately computed family sizes int nfsz */
 784
 785         /* catch the horst-case */
 786         if (UNLIKELY(nfam == 0)) {
 787                 *sum = *cart = *perm = 0;
 788                 return 0UL;
 789         } else if (nfam == 1) {
 790                 /* another horst case
 791                  * just 1 fam should always call fam_size() */
 792                 *perm = 1;
 793                 return *sum = *cart = nfsz[0] = __fam_size(fam[0]);
 794         }
 795         /* otherwise unroll a little */
 796         nfsz[0] = __fam_size(fam[0]);
 797         nfsz[1] = __fam_size(fam[1]);
 798         *sum = nfsz[0] + nfsz[1];
 799         *cart = nfsz[0] * nfsz[1];
 800         for (size_t j = 2; j < nfam; j++) {
 801                 nfsz[j] = __fam_size(fam[j]);
 802                 *sum += nfsz[j];
 803                 *cart *= nfsz[j];
 804         }
 805         *cart *= (*perm = __factorial(nfam));
 806         return *sum + *cart;
 807 }
 808
 809 static inline size_t
 810 __nfam_perm_sum_size_a(size_t *sum, size_t *var, size_t *perm, size_t *midxsz,
 811                        size_t nfsz[],
 812                        Lisp_Object fam[], size_t nfam, size_t arity[])
 813 {
 814 /* computes the size of the cartesian set (returned), the maximum size of
 815  * the union set and the multiplicity of the multi-index (which is the
 816  * cross sum of the arity array) returns the sum of cartesian and union,
 817  * and puts intermediately computed family sizes into nfsz */
 818
 819         /* catch the horst-case */
 820         if (UNLIKELY(nfam == 0)) {
 821                 *sum = *var = *perm = *midxsz = 0;
 822                 return 0UL;
 823         } else if (nfam == 1) {
 824                 /* another horst case
 825                  * just 1 fam should always call fam_size() */
 826                 *sum = nfsz[0] = __fam_size(fam[0]);
 827                 *perm = __factorial(*midxsz = arity[0]);
 828                 *var = __ncombinations(nfsz[0], arity[0]) * *perm;
 829                 return *sum + *var;
 830         }
 831         /* otherwise unroll a little */
 832         nfsz[0] = __fam_size(fam[0]);
 833         nfsz[1] = __fam_size(fam[1]);
 834         *sum = nfsz[0] + nfsz[1];
 835         *midxsz = arity[0] + arity[1];
 836         *var = __ncombinations(nfsz[0], arity[0]) *
 837                 __ncombinations(nfsz[1], arity[1]);
 838         for (size_t j = 2; j < nfam; j++) {
 839                 nfsz[j] = __fam_size(fam[j]);
 840                 *sum += nfsz[j];
 841                 *midxsz += arity[j];
 842                 *var *= __ncombinations(nfsz[j], arity[j]);
 843         }
 844         /* we computed the number of combinations above, now to compute
 845          * the number of variations we have to apply the S_{midxsz} on
 846          * each element, hence we simply multiply with the factorial of
 847          * midxsz (which is the cross sum of all arities) */
 848         *var *= (*perm = __factorial(*midxsz));
 849         return *sum + *var;
 850 }
 851
 852 /* combinations
 853  * dedicated subroutines for 2-combs and 3-combs because they are soooo easy
 854  */
 855 static void
 856 __2comb(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
 857         Lisp_Object supp[], size_t slen,
 858         Lisp_Object fun, glue_f gf)
 859 {
 860 /* assumes that everything is gcpro'd properly */
 861         Lisp_Object arr[3] = {fun, Qnil, Qnil};
 862
 863         if (LIKELY(!NILP(fun) && gf == NULL)) {
 864                 for (size_t i = 0, l = 0; i < slen-1; i++) {
 865                         for (size_t j = i+1; j < slen; j++) {
 866                                 /* set up the array */
 867                                 arr[1] = supp[i];
 868                                 arr[2] = supp[j];
 869                                 /* apply fun */
 870                                 tgts[l++] = Ffuncall(countof(arr), arr);
 871                         }
 872                 }
 873         } else if (LIKELY(!NILP(fun))) {
 874                 for (size_t i = 0, l = 0; i < slen-1; i++) {
 875                         for (size_t j = i+1; j < slen; j++) {
 876                                 /* set up the array */
 877                                 arr[1] = supp[i];
 878                                 arr[2] = supp[j];
 879                                 /* glue */
 880                                 arr[1] = gf(2, &arr[1]);
 881                                 /* apply fun */
 882                                 tgts[l++] = Ffuncall(2, arr);
 883                         }
 884                 }
 885         } else {
 886                 glue_f tgf = gf ? gf : Flist;
 887                 for (size_t i = 0, l = 0; i < slen-1; i++) {
 888                         for (size_t j = i+1; j < slen; j++) {
 889                                 /* set up the array */
 890                                 arr[1] = supp[i];
 891                                 arr[2] = supp[j];
 892                                 /* glue */
 893                                 tgts[l++] = tgf(2, &arr[1]);
 894                         }
 895                 }
 896         }
 897         return;
 898 }
 899
 900 static void
 901 __3comb(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
 902         Lisp_Object supp[], size_t slen,
 903         Lisp_Object fun, glue_f gf)
 904 {
 905 /* assumes that everything is gcpro'd properly */
 906         Lisp_Object arr[4] = {fun, Qnil, Qnil, Qnil};
 907
 908         if (LIKELY(!NILP(fun) && gf == NULL)) {
 909                 for (size_t i = 0, l = 0; i < slen-2; i++) {
 910                         for (size_t j = i+1; j < slen-1; j++) {
 911                                 for (size_t k = j+1; k < slen; k++) {
 912                                         /* set up the array */
 913                                         arr[1] = supp[i];
 914                                         arr[2] = supp[j];
 915                                         arr[3] = supp[k];
 916                                         /* apply fun */
 917                                         tgts[l++] = Ffuncall(countof(arr), arr);
 918                                 }
 919                         }
 920                 }
 921         } else if (LIKELY(!NILP(fun))) {
 922                 for (size_t i = 0, l = 0; i < slen-2; i++) {
 923                         for (size_t j = i+1; j < slen-1; j++) {
 924                                 for (size_t k = j+1; k < slen; k++) {
 925                                         /* set up the array */
 926                                         arr[1] = supp[i];
 927                                         arr[2] = supp[j];
 928                                         arr[3] = supp[k];
 929                                         /* glue */
 930                                         arr[1] = gf(3, &arr[1]);
 931                                         /* apply fun */
 932                                         tgts[l++] = Ffuncall(2, arr);
 933                                 }
 934                         }
 935                 }
 936         } else {
 937                 glue_f tgf = gf ? gf : Flist;
 938                 for (size_t i = 0, l = 0; i < slen-2; i++) {
 939                         for (size_t j = i+1; j < slen-1; j++) {
 940                                 for (size_t k = j+1; k < slen; k++) {
 941                                         /* set up the array */
 942                                         arr[1] = supp[i];
 943                                         arr[2] = supp[j];
 944                                         arr[3] = supp[k];
 945                                         /* glue */
 946                                         tgts[l++] = tgf(3, &arr[1]);
 947                                 }
 948                         }
 949                 }
 950         }
 951         return;
 952 }
 953
 954 static void
 955 __ncomb(Lisp_Object tgts[], size_t tlen,
 956         Lisp_Object supp[], size_t slen,
 957         Lisp_Object fun, glue_f gf,
 958         size_t arity)
 959 {
 960 /* assumes that everything is gcpro'd properly */
 961         size_t idx[arity+1];
 962         size_t l = 0;
 963         Lisp_Object fc[arity+1], *v = &fc[1];
 964
 965         /* setup */
 966         memset(idx, 0, arity*sizeof(long int));
 967         memset(v, 0, arity*sizeof(Lisp_Object));
 968         fc[0] = fun;
 969
 970         /* special case slen == arity */
 971         if (UNLIKELY(slen == arity)) {
 972                 if (LIKELY(!NILP(fun) && gf == NULL)) {
 973                         tgts[0] = Ffuncall(slen, supp);
 974                 } else if (LIKELY(!NILP(fun))) {
 975                         v[0] = gf(slen, supp);
 976                         tgts[0] = Ffuncall(2, fc);
 977                 } else {
 978                         glue_f tgf = gf ? gf : Flist;
 979                         tgts[0] = tgf(slen, supp);
 980                 }
 981                 return;
 982         }
 983
 984         /* setup, partially unrolled */
 985         idx[0] = 0;
 986         idx[1] = 1;
 987         for (size_t i = 2; i < arity; i++) {
 988                 idx[i] = i;
 989         }
 990
 991         if (LIKELY(!NILP(fun) && gf == NULL)) {
 992                 while (l < tlen) {
 993                         v[0] = supp[idx[0]];
 994                         v[1] = supp[idx[1]];
 995                         for (size_t i = 2; i < arity; i++) {
 996                                 v[i] = supp[idx[i]];
 997                         }
 998                         /* apply fun */
 999                         tgts[l++] = Ffuncall(countof(fc), fc);
1000                         /* increment, fooking back'n'forth-loop-based
1001                          * IMPROVE THAT */
1002                         (void)__advance_multi_index_comb(idx, slen, arity);
1003                 }
1004         } else if (LIKELY(!NILP(fun))) {
1005                 while (l < tlen) {
1006                         v[0] = supp[idx[0]];
1007                         v[1] = supp[idx[1]];
1008                         for (size_t i = 2; i < arity; i++) {
1009                                 v[i] = supp[idx[i]];
1010                         }
1011                         /* glue */
1012                         v[0] = gf(arity, v);
1013                         /* apply fun */
1014                         tgts[l++] = Ffuncall(2, fc);
1015                         /* increment, fooking back'n'forth-loop-based
1016                          * IMPROVE THAT */
1017                         (void)__advance_multi_index_comb(idx, slen, arity);
1018                 }
1019         } else {
1020                 glue_f tgf = gf ? gf : Flist;
1021                 while (l < tlen) {
1022                         v[0] = supp[idx[0]];
1023                         v[1] = supp[idx[1]];
1024                         for (size_t i = 2; i < arity; i++) {
1025                                 v[i] = supp[idx[i]];
1026                         }
1027                         /* glue */
1028                         tgts[l++] = tgf(arity, v);
1029                         /* increment, fooking back'n'forth-loop-based
1030                          * IMPROVE THAT */
1031                         (void)__advance_multi_index_comb(idx, slen, arity);
1032                 }
1033         }
1034         return;
1035 }
1036
1037
1038 /* permutations
1039  * dedicated subroutines for 2-perms and 3-perms because they are soooo easy
1040  * 2-perms (transpositions) is just a 2-cycle along with its transposition,
1041  * so we can directly reuse the comb algorithm
1042  * 3-perms are just as simple, since the generation of S_3 can simply be put
1043  * as (), a, a^2, b, a*b, a^2*b where a is a 3-cycle and b a 2-cycle.
1044  */
1045 static inline size_t
1046 __2perm_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1047             Lisp_Object supp[], size_t SXE_UNUSED(slen),
1048             Lisp_Object fun,
1049             size_t offset)
1050         __attribute__((always_inline));
1051 static inline size_t
1052 __2perm_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1053             Lisp_Object supp[], size_t SXE_UNUSED(slen),
1054             Lisp_Object fun,
1055             size_t offset)
1056 {
1057 /* apply fun on S_2 on (the first two elements of) supp */
1058         Lisp_Object arr[3] = {fun, Qnil, Qnil};
1059
1060         /* set up the array */
1061         arr[1] = supp[0];
1062         arr[2] = supp[1];
1063         /* and apply fun */
1064         tgts[offset++] = Ffuncall(countof(arr), arr);
1065
1066         /* swap them == (1,2) */
1067         arr[1] = supp[1];
1068         arr[2] = supp[0];
1069         /* and apply fun */
1070         tgts[offset++] = Ffuncall(countof(arr), arr);
1071         return offset;
1072 }
1073
1074 static inline size_t
1075 __2perm_glue_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1076                  Lisp_Object supp[], size_t SXE_UNUSED(slen),
1077                  Lisp_Object fun, glue_f gf,
1078                  size_t offset)
1079         __attribute__((always_inline));
1080 static inline size_t
1081 __2perm_glue_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1082                  Lisp_Object supp[], size_t SXE_UNUSED(slen),
1083                  Lisp_Object fun, glue_f gf,
1084                  size_t offset)
1085 {
1086 /* apply fun on the glue of S_2 on (the first two elements of) supp */
1087         Lisp_Object arr[3] = {fun, Qnil, Qnil};
1088
1089         /* set up the array */
1090         arr[1] = supp[0];
1091         arr[2] = supp[1];
1092         /* apply glue */
1093         arr[1] = gf(2, &arr[1]);
1094         /* apply fun */
1095         tgts[offset++] = Ffuncall(2, arr);
1096
1097         /* swap them == (1,2) */
1098         arr[1] = supp[1];
1099         arr[2] = supp[0];
1100         /* apply glue */
1101         arr[1] = gf(2, &arr[1]);
1102         /* and apply fun */
1103         tgts[offset++] = Ffuncall(2, arr);
1104         return offset;
1105 }
1106
1107 static inline size_t
1108 __2perm_glue(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1109              Lisp_Object supp[], size_t SXE_UNUSED(slen),
1110              glue_f gf,
1111              size_t offset)
1112         __attribute__((always_inline));
1113 static inline size_t
1114 __2perm_glue(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1115              Lisp_Object supp[], size_t SXE_UNUSED(slen),
1116              glue_f gf,
1117              size_t offset)
1118 {
1119 /* glue of S_2 on (the first two elements of) supp */
1120         volatile Lisp_Object tmp = supp[0];
1121
1122         /* directly apply glue */
1123         tgts[offset++] = gf(2, supp);
1124
1125         /* swap them == (1,2) */
1126         supp[0] = supp[1];
1127         supp[1] = tmp;
1128         /* apply glue */
1129         tgts[offset++] = gf(2, supp);
1130         return offset;
1131 }
1132
1133 static inline size_t
1134 _2perm(Lisp_Object tgts[], size_t tlen,
1135        Lisp_Object supp[], size_t slen,
1136        Lisp_Object fun, glue_f gf,
1137        size_t offset)
1138 {
1139 /* assumes that everything is gcpro'd correctly */
1140         if (LIKELY(!NILP(fun) && gf == NULL)) {
1141                 return __2perm_fun(tgts, tlen, supp, slen, fun, offset);
1142         } else if (LIKELY(!NILP(fun))) {
1143                 return __2perm_glue_fun(tgts, tlen, supp, slen,
1144                                         fun, gf, offset);
1145         } else {
1146                 return __2perm_glue(tgts, tlen, supp, slen,
1147                                     gf ? gf : Flist, offset);
1148         }
1149 }
1150
1151 static void
1152 _comb_2perm(Lisp_Object *tgts, size_t tlen,
1153             Lisp_Object *supp, size_t slen,
1154             Lisp_Object fun, glue_f gf)
1155 {
1156 /* loop over everything in supp and form combinations thereof,
1157  * apply S_2 on them
1158  * assumes that everything is gcpro'd correctly */
1159         Lisp_Object v[2] = {Qnil, Qnil};
1160
1161         if (LIKELY(!NILP(fun) && gf == NULL)) {
1162                 for (size_t i = 0, l = 0; i < slen-1; i++) {
1163                         for (size_t j = i+1; j < slen; j++) {
1164                                 v[0] = supp[i];
1165                                 v[1] = supp[j];
1166                                 l = __2perm_fun(tgts, tlen, v, 2, fun, l);
1167                         }
1168                 }
1169
1170         } else if (LIKELY(!NILP(fun))) {
1171                 for (size_t i = 0, l = 0; i < slen-1; i++) {
1172                         for (size_t j = i+1; j < slen; j++) {
1173                                 v[0] = supp[i];
1174                                 v[1] = supp[j];
1175                                 l = __2perm_glue_fun(
1176                                         tgts, tlen, v, 2, fun, gf, l);
1177                         }
1178                 }
1179
1180         } else {
1181                 glue_f tgf = gf ? gf : Flist;
1182                 for (size_t i = 0, l = 0; i < slen-1; i++) {
1183                         for (size_t j = i+1; j < slen; j++) {
1184                                 v[0] = supp[i];
1185                                 v[1] = supp[j];
1186                                 l = __2perm_glue(tgts, tlen, v, 2, tgf, l);
1187                         }
1188                 }
1189         }
1190         return;
1191 }
1192
1193 /* 3 perms */
1194 static inline size_t
1195 __3perm_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1196             Lisp_Object supp[], size_t SXE_UNUSED(slen),
1197             Lisp_Object fun,
1198             size_t offset)
1199         __attribute__((always_inline));
1200 static inline size_t
1201 __3perm_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1202             Lisp_Object supp[], size_t SXE_UNUSED(slen),
1203             Lisp_Object fun,
1204             size_t offset)
1205 {
1206 /* apply fun on S_3 on (the first 3 elements of) supp */
1207         Lisp_Object arr[4] = {fun, Qnil, Qnil, Qnil};
1208
1209         /* we use gap's order of the elements of S3
1210          * gap> Elements(SymmetricGroup(3));
1211          * [ (), (2,3), (1,2), (1,2,3), (1,3,2), (1,3) ] */
1212
1213         /* () */
1214         arr[1] = supp[0];
1215         arr[2] = supp[1];
1216         arr[3] = supp[2];
1217         /* and apply fun */
1218         tgts[offset++] = Ffuncall(countof(arr), arr);
1219
1220         /* (2,3) */
1221         arr[2] = supp[2];
1222         arr[3] = supp[1];
1223         /* and apply fun */
1224         tgts[offset++] = Ffuncall(countof(arr), arr);
1225
1226         /* (1,2) */
1227         arr[1] = supp[1];
1228         arr[2] = supp[0];
1229         arr[3] = supp[2];
1230         /* and apply fun */
1231         tgts[offset++] = Ffuncall(countof(arr), arr);
1232
1233         /* (1,2,3) */
1234         arr[2] = supp[2];
1235         arr[3] = supp[0];
1236         /* and apply fun */
1237         tgts[offset++] = Ffuncall(countof(arr), arr);
1238
1239         /* (1,3,2) */
1240         arr[1] = supp[2];
1241         arr[2] = supp[0];
1242         arr[3] = supp[1];
1243         /* and apply fun */
1244         tgts[offset++] = Ffuncall(countof(arr), arr);
1245
1246         /* (1,3) */
1247         arr[2] = supp[1];
1248         arr[3] = supp[0];
1249         /* and apply fun */
1250         tgts[offset++] = Ffuncall(countof(arr), arr);
1251
1252         return offset;
1253 }
1254
1255 static inline size_t
1256 __3perm_glue_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1257                  Lisp_Object supp[], size_t SXE_UNUSED(slen),
1258                  Lisp_Object fun, glue_f gf,
1259                  size_t offset)
1260         __attribute__((always_inline));
1261 static inline size_t
1262 __3perm_glue_fun(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1263                  Lisp_Object supp[], size_t SXE_UNUSED(slen),
1264                  Lisp_Object fun, glue_f gf,
1265                  size_t offset)
1266 {
1267 /* apply fun on the glue of S_3 on (the first 3 elements of) supp */
1268         Lisp_Object arr[4] = {fun, Qnil, Qnil, Qnil};
1269
1270         /* we use gap's order of the elements of S3
1271          * gap> Elements(SymmetricGroup(3));
1272          * [ (), (2,3), (1,2), (1,2,3), (1,3,2), (1,3) ] */
1273
1274         /* () */
1275         arr[1] = supp[0];
1276         arr[2] = supp[1];
1277         arr[3] = supp[2];
1278         /* apply glue */
1279         arr[1] = gf(3, &arr[1]);
1280         /* apply fun */
1281         tgts[offset++] = Ffuncall(2, arr);
1282
1283         /* (2,3) */
1284         arr[1] = supp[0];
1285         arr[2] = supp[2];
1286         arr[3] = supp[1];
1287         /* apply glue */
1288         arr[1] = gf(3, &arr[1]);
1289         /* and apply fun */
1290         tgts[offset++] = Ffuncall(2, arr);
1291
1292         /* (1,2) */
1293         arr[1] = supp[1];
1294         arr[2] = supp[0];
1295         arr[3] = supp[2];
1296         /* apply glue */
1297         arr[1] = gf(3, &arr[1]);
1298         /* and apply fun */
1299         tgts[offset++] = Ffuncall(2, arr);
1300
1301         /* (1,2,3) */
1302         arr[1] = supp[1];
1303         arr[2] = supp[2];
1304         arr[3] = supp[0];
1305         /* apply glue */
1306         arr[1] = gf(3, &arr[1]);
1307         /* and apply fun */
1308         tgts[offset++] = Ffuncall(2, arr);
1309
1310         /* (1,3,2) */
1311         arr[1] = supp[2];
1312         arr[2] = supp[0];
1313         arr[3] = supp[1];
1314         /* apply glue */
1315         arr[1] = gf(3, &arr[1]);
1316         /* and apply fun */
1317         tgts[offset++] = Ffuncall(2, arr);
1318
1319         /* (1,3) */
1320         arr[1] = supp[2];
1321         arr[2] = supp[1];
1322         arr[3] = supp[0];
1323         /* apply glue */
1324         arr[1] = gf(3, &arr[1]);
1325         /* and apply fun */
1326         tgts[offset++] = Ffuncall(2, arr);
1327
1328         return offset;
1329 }
1330
1331 static inline size_t
1332 __3perm_glue(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1333              Lisp_Object supp[], size_t SXE_UNUSED(slen),
1334              glue_f gf,
1335              size_t offset)
1336         __attribute__((always_inline));
1337 static inline size_t
1338 __3perm_glue(Lisp_Object tgts[], size_t SXE_UNUSED(tlen),
1339              Lisp_Object supp[], size_t SXE_UNUSED(slen),
1340              glue_f gf,
1341              size_t offset)
1342 {
1343 /* glue of S_3 on (the first 3 elements of) supp */
1344         volatile Lisp_Object tmp;
1345
1346         /* we use gap's order of the elements of S3
1347          * gap> Elements(SymmetricGroup(3));
1348          * [ (), (2,3), (1,2), (1,2,3), (1,3,2), (1,3) ] */
1349
1350         /* (), directly apply glue */
1351         tgts[offset++] = gf(3, supp);
1352
1353         /* (1,2) */
1354         tmp = supp[1];
1355         supp[1] = supp[2];
1356         supp[2] = tmp;
1357         /* apply glue */
1358         tgts[offset++] = gf(3, supp);
1359
1360         /* (0,1) == (0,1)(1,2)(1,2) == (0,1,2)(1,2) */
1361         tmp = supp[2];
1362         supp[2] = supp[1];
1363         supp[1] = supp[0];
1364         supp[0] = tmp;
1365         /* apply glue */
1366         tgts[offset++] = gf(3, supp);
1367
1368         /* (0,1,2) == (0,2)(0,1) */
1369         tmp = supp[1];
1370         supp[1] = supp[2];
1371         supp[2] = tmp;
1372         /* apply glue */
1373         tgts[offset++] = gf(3, supp);
1374
1375         /* (0,2,1) == (0,1,2)(0,1,2) */
1376         tmp = supp[0];
1377         supp[0] = supp[1];
1378         supp[1] = supp[2];
1379         supp[2] = tmp;
1380         /* apply glue */
1381         tgts[offset++] = gf(3, supp);
1382
1383         /* (0,2) == (0,1)(0,2,1) */
1384         tmp = supp[1];
1385         supp[1] = supp[2];
1386         supp[2] = tmp;
1387         /* apply glue */
1388         tgts[offset++] = gf(3, supp);
1389
1390         return offset;
1391 }
1392
1393 static void
1394 _comb_3perm(Lisp_Object *tgts, size_t tlen,
1395             Lisp_Object *supp, size_t slen,
1396             Lisp_Object fun, glue_f gf)
1397 {
1398 /* loop over everything in supp and form combinations thereof,
1399  * apply S_3 on them
1400  * assumes that everything is gcpro'd correctly */
1401         Lisp_Object v[3] = {Qnil, Qnil, Qnil};
1402
1403         if (LIKELY(!NILP(fun) && gf == NULL)) {
1404                 for (size_t i = 0, l = 0; i < slen-2; i++) {
1405                         for (size_t j = i+1; j < slen-1; j++) {
1406                                 for (size_t k = j+1; k < slen; k++) {
1407                                         v[0] = supp[i];
1408                                         v[1] = supp[j];
1409                                         v[2] = supp[k];
1410                                         l = __3perm_fun(
1411                                                 tgts, tlen, v, 3, fun, l);
1412                                 }
1413                         }
1414                 }
1415
1416         } else if (LIKELY(!NILP(fun))) {
1417                 for (size_t i = 0, l = 0; i < slen-2; i++) {
1418                         for (size_t j = i+1; j < slen-1; j++) {
1419                                 for (size_t k = j+1; k < slen; k++) {
1420                                         v[0] = supp[i];
1421                                         v[1] = supp[j];
1422                                         v[2] = supp[k];
1423                                         l = __3perm_glue_fun(
1424                                                 tgts, tlen, v, 3, fun, gf, l);
1425                                 }
1426                         }
1427                 }
1428
1429         } else {
1430                 glue_f tgf = gf ? gf : Flist;
1431                 for (size_t i = 0, l = 0; i < slen-2; i++) {
1432                         for (size_t j = i+1; j < slen-1; j++) {
1433                                 for (size_t k = j+1; k < slen; k++) {
1434                                         v[0] = supp[i];
1435                                         v[1] = supp[j];
1436                                         v[2] = supp[k];
1437                                         l = __3perm_glue(
1438                                                 tgts, tlen, v, 3, tgf, l);
1439                                 }
1440                         }
1441                 }
1442         }
1443         return;
1444 }
1445
1446 static inline void
1447 __transpose(Lisp_Object arr[], size_t i, size_t j)
1448         __attribute__((always_inline));
1449 static inline void
1450 __transpose(Lisp_Object arr[], size_t i, size_t j)
1451 {
1452         /* use xchg assembly? */
1453         volatile Lisp_Object tmp = arr[i];
1454         arr[i] = arr[j];
1455         arr[j] = tmp;
1456         return;
1457 }
1458
1459 static inline long int
1460 __divmod3(long int *_div_, long int num)
1461         __attribute__((always_inline));
1462 #if 0
1463 /* idivl uses >48 cycles, which is too slow for division by constants */
1464 static inline long int
1465 __divmod3(long int *_div_, long int num)
1466 {
1467         /* compute _DIV_ div 3 and _DIV_ mod 3,
1468          * store the divisor in `_DIV_', the remainder in `_REM_' */
1469         long int _rem_;
1470
1471         *_div_ = num;
1472         __asm__("idivl %[modulus];  /* eax,edx = eax idivl 3 */\n\t"
1473                 : "=&d" (_rem_), "+%a" (*_div_)
1474                 : [modulus] "rm" (3) : "cc");
1475         return _rem_;
1476 }
1477 #else
1478 static inline long int
1479 __divmod3(long int *_div_, long int num)
1480 {
1481         long int rem = num % 3;
1482         *_div_ = num / 3;
1483         return rem;
1484 }
1485 #endif
1486
1487 static inline long int
1488 __divmodk(long int *_div_, long int modulus)
1489         __attribute__((always_inline));
1490 #if 0
1491 static inline long int
1492 __divmodk(long int *_div_, long int modulus)
1493 {
1494 /* compute _DIV_ div MODULUS and _DIV_ mod MODULUS,
1495  * store the divisor in `_DIV_', the remainder in `_REM_'
1496  * this assembler version takes ... cycles on x86 and x86_64 processors,
1497  * however the generated code below seems to be faster -- and is more
1498  * portable anyway, since it's C */
1499         long int _rem_ = 0;
1500
1501         __asm__("idivl %[modulus];  /* eax,edx = eax idivl 3 */\n\t"
1502                 : "=&d" (_rem_), "+%a" (*_div_)
1503                 : [modulus] "rm" (modulus) : "cc");
1504         return _rem_;
1505 }
1506 #else
1507 static inline long int
1508 __divmodk(long int *_div_, long int modulus)
1509 {
1510         long int rem = *_div_ % modulus;
1511         *_div_ /= modulus;
1512         return rem;
1513 }
1514 #endif
1515
1516 static inline void
1517 __bruhat(Lisp_Object arr[], long int k)
1518         __attribute__((always_inline));
1519 static inline void
1520 __bruhat(Lisp_Object arr[], long int k)
1521 {
1522 /* computes the k-th transposition in quasi bruhat order and
1523  * applies it to arr */
1524
1525         if (UNLIKELY(k == 0)) {
1526                 /* trivial case */
1527                 return;
1528         } else if (k & 1) {
1529                 /* odd Ks always connote (0,1) */
1530                 __transpose(arr, 0, 1);
1531                 return;
1532         } else if (__divmod3(&k, (k >>= 1))) {
1533                 /* 1 mod 3 and 2 mod 3 go to (1,2) */
1534                 __transpose(arr, 1, 2);
1535                 return;
1536         }
1537
1538         /* otherwise k is 0 mod 3 (and we divided by 3 already)
1539          * now we've factored out S_3 already */
1540         switch (k & 3 /* k % 4 */) {
1541         case 1:
1542                 __transpose(arr, 2, 3);
1543                 return;
1544         case 2:
1545                 __transpose(arr, 0, 3);
1546                 return;
1547         case 3:
1548                 __transpose(arr, 1, 3);
1549                 return;
1550         default:
1551                 /* k is 0 mod 4 */
1552                 k >>= 2;
1553         }
1554
1555         /* S_2, S_3, and S_4 is handled about, go on with S_5 now */
1556         for (int i = 5; k; i++) {
1557                 long int rem;
1558                 if ((rem = __divmodk(&k, i))) {
1559                         if (i & 1 || (rem -= 2) < 0) {
1560                                 /* odd i always induces the
1561                                  * (i-1, i) transposition
1562                                  * in C this is (i-2, i-1) */
1563                                 __transpose(arr, i-2, i-1);
1564                         } else {
1565                                 /* even i is uglier :(
1566                                  * if rem == 1 -> (i-1, i)
1567                                  * if rem == 2 -> (1, i)
1568                                  * if rem == 3 -> (2, i)
1569                                  * etc. */
1570                                 __transpose(arr, rem, i-1);
1571                                 /* note: we treated the rem == 1 case above */
1572                         }
1573                         return;
1574                 }
1575         }
1576         return;
1577 }
1578
1579 static inline size_t
1580 __Sn_fun(Lisp_Object tgts[], size_t tlen,
1581          Lisp_Object supp[], size_t slen,
1582          Lisp_Object fun,
1583          size_t offset)
1584         __attribute__((always_inline));
1585 static inline size_t
1586 __Sn_fun(Lisp_Object tgts[], size_t tlen,
1587          Lisp_Object supp[], size_t slen,
1588          Lisp_Object fun,
1589          size_t offset)
1590 {
1591 /* apply FUN on S_n on (the first SLEN elements of) SUPP
1592  * put results into TGTS
1593  * assumes that everything is gcpro'd correctly
1594  * also assumes that tlen == __factorial(slen) */
1595         Lisp_Object arr[slen+1], *v = &arr[1];
1596
1597         /* setup, partially unrolled */
1598         arr[0] = fun;
1599         v[0] = supp[0];
1600         v[1] = supp[1];
1601         v[2] = supp[2];
1602         for (size_t i = 3; i < slen; i++) {
1603                 v[i] = supp[i];
1604         }
1605
1606         /* now we're in the setting ... */
1607         /* we enter the perm loop now, the first addition is the vector
1608          * times identity permutation */
1609         while (tlen-- > 0) {
1610                 tgts[offset++] = Ffuncall(countof(arr), arr);
1611                 /* permute the working vector */
1612                 __bruhat(v, offset);
1613         }
1614         return offset;
1615 }
1616
1617 static inline size_t
1618 __Sn_glue_fun(Lisp_Object tgts[], size_t tlen,
1619               Lisp_Object supp[], size_t slen,
1620               Lisp_Object fun, glue_f gf,
1621               size_t offset)
1622         __attribute__((always_inline));
1623 static inline size_t
1624 __Sn_glue_fun(Lisp_Object tgts[], size_t tlen,
1625               Lisp_Object supp[], size_t slen,
1626               Lisp_Object fun, glue_f gf,
1627               size_t offset)
1628 {
1629 /* apply FUN on glue of S_n on (the first SLEN elements of) SUPP
1630  * put results into TGTS
1631  * assumes that everything is gcpro'd correctly
1632  * also assumes that tlen == __factorial(slen) */
1633         Lisp_Object arr[slen+1], *v = &arr[1];
1634
1635         /* setup, partially unrolled */
1636         arr[0] = fun;
1637         v[0] = supp[0];
1638         v[1] = supp[1];
1639         v[2] = supp[2];
1640         for (size_t i = 3; i < slen; i++) {
1641                 v[i] = supp[i];
1642         }
1643
1644         /* now we're in the setting ... */
1645         /* we enter the perm loop now, the first addition is the vector
1646          * times identity permutation */
1647         while (tlen-- > 0) {
1648                 /* backup that first slot */
1649                 volatile Lisp_Object tmp = v[0];
1650                 v[0] = gf(slen, v);
1651                 tgts[offset++] = Ffuncall(2, arr);
1652                 /* recover from backup slot */
1653                 v[0] = tmp;
1654                 /* permute the working vector */
1655                 __bruhat(v, offset);
1656         }
1657         return offset;
1658 }
1659
1660 static inline size_t
1661 __Sn_glue(Lisp_Object tgts[], size_t tlen,
1662           Lisp_Object supp[], size_t slen,
1663           glue_f gf,
1664           size_t offset)
1665         __attribute__((always_inline));
1666 static inline size_t
1667 __Sn_glue(Lisp_Object tgts[], size_t tlen,
1668           Lisp_Object supp[], size_t slen,
1669           glue_f gf,
1670           size_t offset)
1671 {
1672 /* glue of S_n on (the first SLEN elements of) SUPP
1673  * put results into TGTS
1674  * assumes that everything is gcpro'd correctly
1675  * also assumes that tlen == __factorial(slen) */
1676         Lisp_Object arr[slen];
1677
1678         /* setup, partially unrolled */
1679         arr[0] = supp[0];
1680         arr[1] = supp[1];
1681         arr[2] = supp[2];
1682         for (size_t i = 3; i < slen; i++) {
1683                 arr[i] = supp[i];
1684         }
1685
1686         /* now we're in the setting ... */
1687         /* we enter the perm loop now, the first addition is the vector
1688          * times identity permutation */
1689         while (tlen-- > 0) {
1690                 tgts[offset++] = gf(countof(arr), arr);
1691                 /* permute the working vector */
1692                 __bruhat(arr, offset);
1693         }
1694         return offset;
1695 }
1696
1697 static inline void              /* inline this? */
1698 _Sn(Lisp_Object tgts[], size_t tlen,
1699     Lisp_Object supp[], size_t slen,
1700     Lisp_Object fun, glue_f gf)
1701         __attribute__((always_inline));
1702 static inline void
1703 _Sn(Lisp_Object tgts[], size_t tlen,
1704     Lisp_Object supp[], size_t slen,
1705     Lisp_Object fun, glue_f gf)
1706 {
1707 /* assumes that everything is gcpro'd correctly
1708  * this is just an intermediate switch, the hard work happens in
1709  * __Sn_fun(), __Sn_glue_fun() and __Sn_glue() depending on whether
1710  * just a function and no glue has been specified, a function and a glue
1711  * function has been specified, or just a glue function has been
1712  * specified respectively */
1713
1714         if (LIKELY(!NILP(fun) && gf == NULL)) {
1715                 (void)__Sn_fun(tgts, tlen, supp, slen, fun, 0);
1716         } else if (LIKELY(!NILP(fun))) {
1717                 (void)__Sn_glue_fun(tgts, tlen, supp, slen, fun, gf, 0);
1718         } else {
1719                 glue_f tgf = gf ? gf : Flist;
1720                 (void)__Sn_glue(tgts, tlen, supp, slen, tgf, 0);
1721         }
1722         return;
1723 }
1724
1725 static void
1726 _comb_Sn(Lisp_Object tgts[], size_t tlen,
1727          Lisp_Object supp[], size_t slen,
1728          Lisp_Object fun, glue_f gf,
1729          size_t arity)
1730 {
1731 /* assumes that everything is gcpro'd correctly
1732  * this has the same signature as _Sn() but additionally there's the
1733  * arity argument
1734  * this is basically the code for variations, i.e. applying the S_m
1735  * (m < n) on some subset of size m of a set of size n */
1736         Lisp_Object v[arity];
1737         size_t idx[arity+1];
1738         size_t l = 0, np = __factorial(arity);
1739
1740         /* setup */
1741         memset(idx, 0, arity*sizeof(long int));
1742
1743         /* more setup, partially unrolled */
1744         idx[0] = 0;
1745         idx[1] = 1;
1746         idx[2] = 2;
1747         for (size_t i = 3; i < arity; i++) {
1748                 idx[i] = i;
1749         }
1750
1751         if (LIKELY(!NILP(fun) && gf == NULL)) {
1752                 while (l < tlen) {
1753                         /* get the combinations, serves as starting set,
1754                          * partially unrolled */
1755                         v[0] = supp[idx[0]];
1756                         v[1] = supp[idx[1]];
1757                         v[2] = supp[idx[2]];
1758                         for (size_t i = 3; i < arity; i++) {
1759                                 v[i] = supp[idx[i]];
1760                         }
1761                         /* do the rain dance */
1762                         l = __Sn_fun(tgts, np, v, arity, fun, l);
1763                         /* increment, fooking back'n'forth-loop-based
1764                          * IMPROVEME*/
1765                         (void)__advance_multi_index_comb(idx, slen, arity);
1766                 }
1767         } else if (LIKELY(!NILP(fun))) {
1768                 while (l < tlen) {
1769                         /* get the combinations, serves as starting set,
1770                          * partially unrolled */
1771                         v[0] = supp[idx[0]];
1772                         v[1] = supp[idx[1]];
1773                         v[2] = supp[idx[2]];
1774                         for (size_t i = 3; i < arity; i++) {
1775                                 v[i] = supp[idx[i]];
1776                         }
1777                         /* do the rain dance */
1778                         l = __Sn_glue_fun(tgts, np, v, arity, fun, gf, l);
1779                         /* increment, fooking back'n'forth-loop-based
1780                          * IMPROVEME*/
1781                         (void)__advance_multi_index_comb(idx, slen, arity);
1782                 }
1783         } else {
1784                 glue_f tgf = gf ? gf : Flist;
1785                 while (l < tlen) {
1786                         /* get the combinations, serves as starting set,
1787                          * partially unrolled */
1788                         v[0] = supp[idx[0]];
1789                         v[1] = supp[idx[1]];
1790                         v[2] = supp[idx[2]];
1791                         for (size_t i = 3; i < arity; i++) {
1792                                 v[i] = supp[idx[i]];
1793                         }
1794                         /* do the rain dance */
1795                         l = __Sn_glue(tgts, np, v, arity, tgf, l);
1796                         /* increment, fooking back'n'forth-loop-based
1797                          * IMPROVEME*/
1798                         (void)__advance_multi_index_comb(idx, slen, arity);
1799                 }
1800         }
1801         return;
1802 }
1803
1804
1805 static void
1806 _2cart(Lisp_Object tgts[], size_t tlen,
1807        Lisp_Object supp[], size_t slen,
1808        Lisp_Object fun, glue_f gf)
1809 {
1810 /* assumes that everything is gcpro'd properly
1811  * This function can GC */
1812         Lisp_Object arr[3] = {fun, Qnil, Qnil};
1813
1814         if (LIKELY(!NILP(fun) && gf == NULL)) {
1815                 for (size_t i = 0, l = 0; i < slen; i++) {
1816                         for (size_t j = 0; j < slen; j++) {
1817                                 /* set up the array */
1818                                 arr[1] = supp[i];
1819                                 arr[2] = supp[j];
1820                                 /* apply fun */
1821                                 tgts[l++] = Ffuncall(countof(arr), arr);
1822                         }
1823                 }
1824         } else if (LIKELY(!NILP(fun))) {
1825                 for (size_t i = 0, l = 0; i < slen; i++) {
1826                         for (size_t j = 0; j < slen; j++) {
1827                                 /* set up the array */
1828                                 arr[1] = supp[i];
1829                                 arr[2] = supp[j];
1830                                 /* apply glue */
1831                                 arr[1] = gf(2, &arr[1]);
1832                                 /* apply fun */
1833                                 tgts[l++] = Ffuncall(2, arr);
1834                         }
1835                 }
1836         } else {
1837                 glue_f tgf = gf ? gf : Flist;
1838                 for (size_t i = 0, l = 0; i < slen; i++) {
1839                         for (size_t j = 0; j < slen; j++) {
1840                                 /* set up the array */
1841                                 arr[1] = supp[i];
1842                                 arr[2] = supp[j];
1843                                 /* glue it */
1844                                 tgts[l++] = tgf(2, &arr[1]);
1845                         }
1846                 }
1847         }
1848         return;
1849 }
1850
1851 static void
1852 _3cart(Lisp_Object tgts[], size_t tlen,
1853        Lisp_Object supp[], size_t slen,
1854        Lisp_Object fun, glue_f gf)
1855 {
1856 /* assumes that everything is gcpro'd properly
1857  * This function can GC */
1858         Lisp_Object arr[4] = {fun, Qnil, Qnil, Qnil};
1859
1860         if (LIKELY(!NILP(fun) && gf == NULL)) {
1861                 for (size_t i = 0, l = 0; i < slen; i++) {
1862                         for (size_t j = 0; j < slen; j++) {
1863                                 for (size_t k = 0; k < slen; k++) {
1864                                         /* set up the array */
1865                                         arr[1] = supp[i];
1866                                         arr[2] = supp[j];
1867                                         arr[3] = supp[k];
1868                                         /* apply the fun */
1869                                         tgts[l++] = Ffuncall(countof(arr), arr);
1870                                 }
1871                         }
1872                 }
1873         } else if (LIKELY(!NILP(fun))) {
1874                 for (size_t i = 0, l = 0; i < slen; i++) {
1875                         for (size_t j = 0; j < slen; j++) {
1876                                 for (size_t k = 0; k < slen; k++) {
1877                                         /* set up the array */
1878                                         arr[1] = supp[i];
1879                                         arr[2] = supp[j];
1880                                         arr[3] = supp[k];
1881                                         /* glue */
1882                                         arr[1] = gf(3, &arr[1]);
1883                                         /* apply the fun */
1884                                         tgts[l++] = Ffuncall(2, arr);
1885                                 }
1886                         }
1887                 }
1888         } else {
1889                 glue_f tgf = gf ? gf : Flist;
1890                 for (size_t i = 0, l = 0; i < slen; i++) {
1891                         for (size_t j = 0; j < slen; j++) {
1892                                 for (size_t k = 0; k < slen; k++) {
1893                                         /* set up the array */
1894                                         arr[1] = supp[i];
1895                                         arr[2] = supp[j];
1896                                         arr[3] = supp[k];
1897                                         /* glue */
1898                                         tgts[l++] = tgf(3, &arr[1]);
1899                                 }
1900                         }
1901                 }
1902         }
1903         return;
1904 }
1905
1906 static void
1907 _ncart(Lisp_Object tgts[], size_t tlen,
1908        Lisp_Object supp[], size_t slen,
1909        Lisp_Object fun, glue_f gf,
1910        size_t arity)
1911 {
1912 /* assumes that everything is gcpro'd properly
1913  * This function can GC */
1914         long int idx[arity];    /* the multi-index */
1915         size_t l = 0;
1916         Lisp_Object fc[arity+1], *v = &fc[1];
1917
1918         /* setup */
1919         memset(idx, 0, arity*sizeof(long int));
1920         memset(v, 0, arity*sizeof(Lisp_Object));
1921         fc[0] = fun;
1922
1923         /* now we're in the setting ... */
1924         if (LIKELY(!NILP(fun) && gf == NULL)) {
1925                 while (l < tlen) {
1926                         /* get the fam data, partially unrolled */
1927                         v[0] = supp[idx[0]];
1928                         v[1] = supp[idx[1]];
1929                         v[2] = supp[idx[2]];
1930                         for (size_t i = 3; i < arity; i++) {
1931                                 v[i] = supp[idx[i]];
1932                         }
1933                         /* apply fun */
1934                         tgts[l++] = Ffuncall(countof(fc), fc);
1935                         /* advance the multi-index, partially unrolled */
1936                         __advance_multi_index(idx, arity, slen);
1937                 }
1938         } else if (LIKELY(!NILP(fun))) {
1939                 while (l < tlen) {
1940                         /* get the fam data, partially unrolled */
1941                         v[0] = supp[idx[0]];
1942                         v[1] = supp[idx[1]];
1943                         v[2] = supp[idx[2]];
1944                         for (size_t i = 3; i < arity; i++) {
1945                                 v[i] = supp[idx[i]];
1946                         }
1947                         /* glue */
1948                         v[0] = gf(arity, v);
1949                         /* apply fun */
1950                         tgts[l++] = Ffuncall(2, fc);
1951                         /* advance the multi-index, partially unrolled */
1952                         __advance_multi_index(idx, arity, slen);
1953                 }
1954         } else {
1955                 glue_f tgf = gf ? gf : Flist;
1956                 while (l < tlen) {
1957                         /* get the fam data, partially unrolled */
1958                         v[0] = supp[idx[0]];
1959                         v[1] = supp[idx[1]];
1960                         v[2] = supp[idx[2]];
1961                         for (size_t i = 3; i < arity; i++) {
1962                                 v[i] = supp[idx[i]];
1963                         }
1964                         /* glue */
1965                         tgts[l++] = tgf(arity, v);
1966                         /* advance the multi-index, partially unrolled */
1967                         __advance_multi_index(idx, arity, slen);
1968                 }
1969         }
1970         return;
1971 }
1972
1973 /* more helpers */
1974 static Lisp_Object
1975 __dress_result(Lisp_Object rtype, Lisp_Object arr[], size_t len)
1976 {
1977         /* from most likely to least likely */
1978         if (EQ(rtype, Qlist)) {
1979                 return __Flist(len, arr);
1980         } else if (EQ(rtype, Qvector)) {
1981                 return Fvector(len, arr);
1982         } else if (EQ(rtype, Qdllist)) {
1983                 return Fdllist(len, arr);
1984         } else if (EQ(rtype, Qlitter) || EQ(rtype, Qvoid)) {
1985                 return Qt;
1986         } else if (EQ(rtype, Qinplace)) {
1987                 return Qt;
1988         } else if (EQ(rtype, Qstring)) {
1989                 return Fstring(len, arr);
1990         } else if (EQ(rtype, Qbit_vector)) {
1991                 return Fbit_vector(len, arr);
1992         } else if (EQ(rtype, Qconcat)) {
1993                 return Fconcat(len, arr);
1994         }
1995         return Qnil;
1996 }
1997
1998 static inline size_t
1999 __explode_1dict(Lisp_Object *restrict tkeys, Lisp_Object *restrict tvals,
2000                 Lisp_Object dict, size_t len)
2001         __attribute__((always_inline));
2002 static inline size_t
2003 __explode_1dict(Lisp_Object *restrict tkeys, Lisp_Object *restrict tvals,
2004                 Lisp_Object dict, size_t len)
2005 {
2006         size_t i = 0;
2007         dict_t d = (dict_t)(void*)dict;
2008         struct dict_iter_s _di, *di = &_di;
2009
2010         dict_iter_init(d, di);
2011
2012         while (1) {
2013                 Lisp_Object key, val;
2014                 dict_iter_next(di, &key, &val);
2015                 if (LIKELY(key != Qnull_pointer)) {
2016                         tkeys[i] = key;
2017                         tvals[i] = val;
2018                         i++;
2019                 } else {
2020                         break;
2021                 }
2022         }
2023
2024         dict_iter_fini(di);
2025         return i;
2026 }
2027
2028 static Lisp_Object
2029 __comb_1seq(Lisp_Object seq, Lisp_Object fun, size_t arity,
2030             glue_f gluef, Lisp_Object result_type)
2031 {
2032         size_t fs = __fam_size(seq);
2033         size_t nc = __ncombinations(fs, arity != -1UL ? arity : (arity = fs));
2034         /* C99 we need you */
2035         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2036         size_t leni =
2037                 /* leave room for stuff after us,
2038                  * we call a function on this, so leave plenty of space */
2039                 nc * 3 + fs < maxsz
2040                 ? nc + fs       /* actually we just need nc + arity - 1 */
2041                 : 0;
2042         Lisp_Object __vals[leni], *vals, *rvals, result;
2043         int speccnt = 0;
2044         struct gcpro gcpro1;
2045
2046         if (UNLIKELY(arity == 0 || nc == 0)) {
2047                 /* expherts only */
2048                 return __dress_result(result_type, NULL, 0);
2049         }
2050
2051         if (UNLIKELY(leni == 0)) {
2052                 speccnt = specpdl_depth();
2053                 vals = xnew_array(Lisp_Object, nc + fs);
2054                 record_unwind_protect(free_malloced_ptr, make_opaque_ptr(vals));
2055         } else {
2056                 vals = __vals;
2057         }
2058
2059         /* explode the sequence */
2060         memset(vals, 0, nc * sizeof(Lisp_Object));
2061         (void)seq_explode((void*restrict*)&vals[nc], fs, (seq_t)seq);
2062
2063         GCPROn(vals, nc+fs);
2064         switch (arity) {
2065         case 1:
2066                 /* the same as pntw mode */
2067                 /* expherts only */
2068                 if (UNLIKELY(NILP(fun) || nc == 0UL)) {
2069                         rvals = &vals[nc];
2070                         break;
2071                 }
2072
2073                 for (size_t i = nc; i < nc + fs; i++) {
2074                         Lisp_Object args[2] = {fun, vals[i]};
2075                         vals[i] = Ffuncall(2, args);
2076                 }
2077                 rvals = &vals[nc];
2078                 break;
2079         case 2:
2080                 __2comb(vals, nc, &vals[nc], fs, fun, gluef);
2081                 rvals = vals;
2082                 break;
2083         case 3:
2084                 __3comb(vals, nc, &vals[nc], fs, fun, gluef);
2085                 rvals = vals;
2086                 break;
2087         default:
2088                 __ncomb(vals, nc, &vals[nc], fs, fun, gluef, arity);
2089                 rvals = vals;
2090                 break;
2091         }
2092         result = __dress_result(result_type, rvals, nc);
2093         UNGCPRO;
2094         if (UNLIKELY(leni == 0)) {
2095                 unbind_to(speccnt, Qnil);
2096         }
2097         return result;
2098 }
2099
2100 static Lisp_Object
2101 __perm_1seq(Lisp_Object seq, Lisp_Object fun, size_t arity,
2102             glue_f gluef, Lisp_Object result_type)
2103 {
2104         size_t fs = __fam_size(seq);
2105         size_t nv = __nvariations(fs, arity != -1UL ? arity : (arity = fs));
2106         /* C99 we need you */
2107         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2108         size_t leni =
2109                 /* leave room for stuff after us,
2110                  * we call a function on this, so leave plenty of space */
2111                 nv * 3 < maxsz
2112                 ? nv + fs
2113                 : 0;
2114         Lisp_Object __vals[leni], *vals, *rvals = NULL, result;
2115         int speccnt = 0;
2116         struct gcpro gcpro1;
2117
2118         if (UNLIKELY(leni == 0)) {
2119                 speccnt = specpdl_depth();
2120                 vals = xnew_array(Lisp_Object, nv + fs);
2121                 record_unwind_protect(free_malloced_ptr, make_opaque_ptr(vals));
2122         } else {
2123                 vals = __vals;
2124         }
2125
2126         if (UNLIKELY(arity == 0)) {
2127                 /* expherts only */
2128                 return __dress_result(result_type, NULL, 0);
2129         }
2130
2131         /* explode the sequence */
2132         memset(vals, 0, (nv) * sizeof(Lisp_Object));
2133         (void)seq_explode((void*restrict*)&vals[nv], fs, (seq_t)seq);
2134
2135         GCPROn(vals, nv + fs);
2136         switch (arity) {
2137         case 1:
2138                 /* the same as pntw mode */
2139                 /* expherts only */
2140                 if (UNLIKELY(NILP(fun) || nv == 0UL)) {
2141                         rvals = &vals[nv];
2142                         break;
2143                 }
2144
2145                 for (size_t i = nv; i < nv+fs; i++) {
2146                         Lisp_Object args[2] = {fun, vals[i]};
2147                         vals[i] = Ffuncall(2, args);
2148                 }
2149                 rvals = &vals[nv];
2150                 break;
2151         case 2:
2152                 _comb_2perm(vals, nv, &vals[nv], fs, fun, gluef);
2153                 rvals = vals;
2154                 break;
2155         case 3:
2156                 _comb_3perm(vals, nv, &vals[nv], fs, fun, gluef);
2157                 rvals = vals;
2158                 break;
2159         default:
2160                 if (LIKELY(fs != arity)) {
2161                         _comb_Sn(vals, nv, &vals[nv], fs, fun, gluef, arity);
2162                 } else {
2163                         /* optimised for mere permutations */
2164                         _Sn(vals, nv, &vals[nv], fs /*== arity*/, fun, gluef);
2165                 }
2166                 rvals = vals;
2167                 break;
2168         }
2169         result = __dress_result(result_type, rvals, nv);
2170         UNGCPRO;
2171         if (UNLIKELY(leni == 0)) {
2172                 unbind_to(speccnt, Qnil);
2173         }
2174         return result;
2175 }
2176
2177 static Lisp_Object
2178 __cart_1seq(Lisp_Object seq, Lisp_Object fun, size_t arity,
2179             glue_f gluef, Lisp_Object result_type)
2180 {
2181         size_t fs = __fam_size(seq);
2182         size_t nc = __ncart(fs, arity);
2183         /* C99 we need you */
2184         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2185         size_t leni =
2186                 /* leave room for stuff after us,
2187                  * we call a function on this, so leave plenty of space */
2188                 nc * 3 < maxsz
2189                 ? nc
2190                 : 0;
2191         Lisp_Object __vals[leni], *vals, result;
2192         int speccnt = 0;
2193         struct gcpro gcpro1;
2194
2195         if (UNLIKELY(arity == 0)) {
2196                 /* expherts only */
2197                 return __dress_result(result_type, NULL, 0);
2198         }
2199
2200         if (UNLIKELY(leni == 0)) {
2201                 speccnt = specpdl_depth();
2202                 vals = xnew_array(Lisp_Object, nc);
2203                 record_unwind_protect(free_malloced_ptr, make_opaque_ptr(vals));
2204         } else {
2205                 vals = __vals;
2206         }
2207
2208         /* explode the sequence */
2209         memset(vals, 0, (nc - fs) * sizeof(Lisp_Object));
2210         seq_explode((void*restrict*)&vals[nc - fs], fs, (seq_t)seq);
2211
2212         GCPROn(vals, nc);
2213         switch (arity) {
2214         case 1:
2215                 /* the same as pntw mode */
2216                 /* expherts only */
2217                 if (UNLIKELY(NILP(fun) || nc == 0UL)) {
2218                         break;
2219                 }
2220
2221                 for (size_t i = 0; i < nc; i++) {
2222                         Lisp_Object args[2] = {fun, vals[i]};
2223                         vals[i] = Ffuncall(2, args);
2224                 }
2225                 break;
2226         case 2:
2227                 _2cart(vals, nc, &vals[nc-fs], fs, fun, gluef);
2228                 break;
2229         case 3:
2230                 _3cart(vals, nc, &vals[nc-fs], fs, fun, gluef);
2231                 break;
2232         default:
2233                 _ncart(vals, nc, &vals[nc-fs], fs, fun, gluef, arity);
2234                 break;
2235         }
2236         result = __dress_result(result_type, vals, nc);
2237         UNGCPRO;
2238         if (UNLIKELY(leni == 0)) {
2239                 unbind_to(speccnt, Qnil);
2240         }
2241         return result;
2242 }
2243
2244 static Lisp_Object
2245 __pntw_1seq(Lisp_Object seq, Lisp_Object fun, size_t arity,
2246             glue_f gluef, Lisp_Object result_type,
2247             struct decoration_s deco)
2248 {
2249         size_t nseq = __fam_size(seq);
2250         /* C99 we need you */
2251         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2252         size_t totlen = nseq + 2 /* for ini and ter */ + (deco.sep ? nseq : 0);
2253         size_t leni =
2254                 /* leave room for stuff after us,
2255                  * we call a function on this, so leave plenty of space */
2256                 nseq * 3 < maxsz
2257                 ? totlen
2258                 : 0;
2259         size_t len = 0;
2260         Lisp_Object __vals[leni+1], *vals, *seqelts, result;
2261
2262         if (arity > nseq) {
2263                 /* expherts alarm */
2264                 return __dress_result(result_type, NULL, 0);
2265         }
2266         if (UNLIKELY(leni == 0)) {
2267                 vals = xnew_array(Lisp_Object, totlen);
2268         } else {
2269                 vals = __vals;
2270         }
2271
2272         /* start maybe with the initiator */
2273         if (UNLIKELY(deco.ini != Qnull_pointer)) {
2274                 vals[len++] = deco.ini;
2275         }
2276         /* explode the sequence */
2277         if (LIKELY(deco.sep == Qnull_pointer)) {
2278                 seqelts = &vals[len];
2279         } else {
2280                 seqelts = vals + (deco.sep ? nseq : 0);
2281                 memset(&vals[len], 0, sizeof(Lisp_Object) * nseq);
2282         }
2283         (void)seq_explode((void*restrict*)seqelts, nseq, (seq_t)seq);
2284
2285         /* fill the rest with naughts */
2286         memset(&seqelts[nseq], 0, (totlen - len - nseq) * sizeof(Lisp_Object));
2287
2288         if (NILP(fun)) {
2289                 switch (arity) {
2290                 case 1:
2291                         if (deco.sep != Qnull_pointer) {
2292                                 /* weave */
2293                                 for (size_t i = 0; i < nseq; i++) {
2294                                         vals[len++] = seqelts[i];
2295                                         vals[len++] = deco.sep;
2296                                 }
2297                                 /* because we dont want the last element to
2298                                  * be followed by a separator */
2299                                 len--;
2300                         } else {
2301                                 len = nseq;
2302                         }
2303                         break;
2304                 case 2:
2305                         /* condense the stuff */
2306                         for (size_t i = 0, bar = nseq & -2;
2307                              /* traverse to the previous even number */
2308                              i < bar;  i += 2) {
2309                                 vals[len++] = gluef
2310                                         ? gluef(2, &seqelts[i])
2311                                         : list2(seqelts[i], seqelts[i+1]);
2312                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2313                                         vals[len++] = deco.sep;
2314                                 }
2315                         }
2316                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2317                                 /* strike the last separator */
2318                                 len--;
2319                         }
2320                         break;
2321                 case 3:
2322                         /* condense the stuff */
2323                         for (size_t i = 0;
2324                              /* traverse to the last 3-divisible index */
2325                              i+3 <= nseq; i += 3) {
2326                                 vals[len++] = gluef
2327                                         ? gluef(3, &seqelts[i])
2328                                         : list3(seqelts[i],
2329                                                 seqelts[i+1],
2330                                                 seqelts[i+2]);
2331                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2332                                         vals[len++] = deco.sep;
2333                                 }
2334                         }
2335                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2336                                 /* strike the last separator */
2337                                 len--;
2338                         }
2339                         break;
2340                 default:
2341                         /* condense the stuff */
2342                         for (int i = 0;
2343                              /* traverse to the last sane index */
2344                              i+arity <= nseq; i += arity) {
2345                                 vals[len++] = gluef
2346                                         ? gluef(arity, &seqelts[i])
2347                                         : Flist(arity, &seqelts[i]);
2348                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2349                                         vals[len++] = deco.sep;
2350                                 }
2351                         }
2352                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2353                                 /* kick the last one */
2354                                 len--;
2355                         }
2356                 }
2357         } else {
2358                 struct gcpro gcpro1;
2359
2360                 switch (arity) {
2361                 case 1:
2362                         GCPROn(vals, totlen);
2363
2364                         for (size_t i = 0; i < nseq; i++) {
2365                                 Lisp_Object args[2] = {fun, seqelts[i]};
2366                                 vals[len++] = Ffuncall(2, args);
2367                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2368                                         vals[len++] = deco.sep;
2369                                 }
2370                         }
2371                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2372                                 /* strike the last separator */
2373                                 len--;
2374                         }
2375
2376                         UNGCPRO;
2377                         break;
2378
2379                 case 2:
2380                         GCPROn(vals, totlen);
2381
2382                         for (size_t i = 0, bar = nseq & -2;
2383                              /* traverse to the last even index */
2384                              i < bar; i += 2) {
2385                                 Lisp_Object args[3] = {fun, seqelts[i], seqelts[i+1]};
2386                                 vals[len++] = Ffuncall(countof(args), args);
2387                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2388                                         vals[len++] = deco.sep;
2389                                 }
2390                         }
2391                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2392                                 /* strike the last separator */
2393                                 len--;
2394                         }
2395
2396                         UNGCPRO;
2397                         break;
2398
2399                 case 3:
2400                         GCPROn(vals, len);
2401
2402                         for (size_t i = 0;
2403                              /* traverse to the last 3-divisible index */
2404                              i+3 <= nseq; i += 3) {
2405                                 Lisp_Object args[4] = {
2406                                         fun, seqelts[i], seqelts[i+1],
2407                                         seqelts[i+2]};
2408                                 vals[len++] = Ffuncall(countof(args), args);
2409                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2410                                         vals[len++] = deco.sep;
2411                                 }
2412                         }
2413                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2414                                 /* strike the last separator */
2415                                 len--;
2416                         }
2417
2418                         UNGCPRO;
2419                         break;
2420
2421                 default:
2422                         GCPROn(vals, len);
2423
2424                         for (size_t i = 0;
2425                              /* traverse to the last 3-divisible index */
2426                              i+arity <= nseq; i += arity) {
2427                                 Lisp_Object args[arity+1];
2428
2429                                 args[0] = fun;
2430                                 args[1] = seqelts[i];
2431                                 args[2] = seqelts[i+1];
2432                                 args[3] = seqelts[i+2];
2433                                 args[4] = seqelts[i+3];
2434                                 for (size_t j = 4; j < arity; j++) {
2435                                         args[j+1] = seqelts[i+j];
2436                                 }
2437                                 vals[len++] = Ffuncall(countof(args), args);
2438                                 if (UNLIKELY(deco.sep != Qnull_pointer)) {
2439                                         /* add separator */
2440                                         vals[len++] = deco.sep;
2441                                 }
2442                         }
2443                         if (UNLIKELY(deco.sep != Qnull_pointer)) {
2444                                 /* kick the last one */
2445                                 len--;
2446                         }
2447
2448                         UNGCPRO;
2449                         break;
2450                 }
2451         }
2452         /* top off with the terminator */
2453         if (UNLIKELY(deco.ter != Qnull_pointer)) {
2454                 vals[len++] = deco.ter;
2455         }
2456
2457         result = __dress_result(result_type, vals, len);
2458         if (UNLIKELY(leni == 0)) {
2459                 xfree(vals);
2460         }
2461         return result;
2462 }
2463
2464 static Lisp_Object
2465 __pntw_1dict(Lisp_Object dict, Lisp_Object fun,
2466              glue_f gluef, Lisp_Object result_type)
2467 {
2468         /* basically like maphash/mapskiplist */
2469         size_t ndict = dict_size((dict_t)(void*)dict);
2470         /* C99 we need you */
2471         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2472         size_t leni =
2473                 /* leave room for stuff after us,
2474                  * we call a function on this, so leave plenty of space */
2475                 ndict * 6 < maxsz
2476                 ? ndict
2477                 : 0;
2478         size_t len;
2479         Lisp_Object __keys[leni], __vals[leni], *keys, *vals, result;
2480
2481         if (UNLIKELY(leni == 0)) {
2482                 keys = xnew_array(Lisp_Object, 2 * ndict);
2483                 vals = &keys[ndict];
2484         } else {
2485                 keys = __keys;
2486                 vals = __vals;
2487         }
2488
2489         /* explode the sequence */
2490         len = __explode_1dict(keys, vals, dict, ndict);
2491
2492         if (LIKELY(!NILP(fun) && len > 0UL)) {
2493                 struct gcpro gcpro1, gcpro2;
2494
2495                 GCPRO1n(dict, vals, len);
2496
2497                 for (size_t i = 0; i < len; i++) {
2498                         Lisp_Object args[3] = {fun, keys[i], vals[i]};
2499                         vals[i] = Ffuncall(countof(args), args);
2500                 }
2501
2502                 UNGCPRO;
2503         } else {
2504                 for (size_t i = 0; i < len; i++) {
2505                         Lisp_Object args[2] = {keys[i], vals[i]};
2506                         vals[i] = gluef
2507                                 ? gluef(countof(args), args)
2508                                 : Flist(countof(args), args);
2509                 }
2510         }
2511
2512         result = __dress_result(result_type, vals, len);
2513         if (UNLIKELY(leni == 0)) {
2514                 xfree(keys);
2515         }
2516         return result;
2517 }
2518
2519 static Lisp_Object
2520 __pntw_nseq(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun,
2521             glue_f gluef, Lisp_Object result_type)
2522 {
2523 /* defaults to arity 1,1,...,1 */
2524         size_t nmin = __nfam_min_size(seqs, nseqs);
2525         /* C99 we need you */
2526         struct seq_iter_s its[nseqs];
2527         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2528         size_t leni =
2529                 /* leave room for stuff after us,
2530                  * we call a function on this, so leave plenty of space */
2531                 nmin * 3 < maxsz
2532                 ? nmin
2533                 : 0;
2534         Lisp_Object __vals[leni], *vals, result;
2535         struct gcpro gcpro1, gcpro2, gcpro3;
2536
2537         if (UNLIKELY(leni == 0)) {
2538                 vals = xnew_array(Lisp_Object, nmin);
2539         } else {
2540                 vals = __vals;
2541         }
2542
2543         /* initialise the value space */
2544         memset(vals, 0, nmin * sizeof(Lisp_Object));
2545         /* initialise the iterators */
2546         for (size_t i = 0; i < nseqs; i++) {
2547                 seq_iter_init((seq_t)seqs[i], &its[i]);
2548         }
2549
2550         GCPRO1nn(fun, vals, nmin, seqs, nseqs);
2551         if (UNLIKELY(NILP(fun))) {
2552                 for (size_t i = 0; i < nmin; i++) {
2553                         Lisp_Object args[nseqs];
2554
2555                         /* unroll */
2556                         seq_iter_next(&its[0], (void**)&args[0]);
2557                         /* and one more */
2558                         seq_iter_next(&its[1], (void**)&args[1]);
2559                         /* ... and the rest */
2560                         for (size_t j = 2; j < nseqs; j++) {
2561                                 seq_iter_next(&its[j], (void**)&args[j]);
2562                         }
2563                         vals[i] = gluef
2564                                 ? gluef(countof(args), args)
2565                                 : Flist(countof(args), args);
2566                 }
2567         } else {
2568                 for (size_t i = 0; i < nmin; i++) {
2569                         Lisp_Object args[nseqs+1];
2570
2571                         /* unroll */
2572                         seq_iter_next(&its[0], (void**)&args[1]);
2573                         /* and one more */
2574                         seq_iter_next(&its[1], (void**)&args[2]);
2575                         /* ... and the rest */
2576                         for (size_t j = 2; j < nseqs; j++) {
2577                                 seq_iter_next(&its[j], (void**)&args[j+1]);
2578                         }
2579                         args[0] = fun;
2580                         vals[i] = Ffuncall(countof(args), args);
2581                 }
2582         }
2583         UNGCPRO;
2584
2585         /* deinitialise the iterators */
2586         for (size_t i = 0; i < nseqs; i++) {
2587                 seq_iter_fini(&its[i]);
2588         }
2589
2590         result = __dress_result(result_type, vals, nmin);
2591         if (UNLIKELY(leni == 0)) {
2592                 xfree(vals);
2593         }
2594         return result;
2595 }
2596
2597 static inline size_t
2598 __arity_cross_sum(size_t arity[], size_t narity)
2599 {
2600         size_t res = arity[0];
2601         for (size_t j = 1; j < narity; j++) {
2602                 res += arity[j];
2603         }
2604         return res;
2605 }
2606
2607 static inline void
2608 __explode_n(seq_iter_t si, void *tgt[], size_t n)
2609 {
2610 /* explodes the sequence in SI N times, puts the stuff into tgt,
2611  * consequently tgt[] is N elements richer thereafter */
2612
2613         seq_iter_next(si, &tgt[0]);
2614         for (size_t j = 1; j < n; j++) {
2615                 seq_iter_next(si, &tgt[j]);
2616         }
2617         return;
2618 }
2619
2620 static Lisp_Object
2621 __pntw_nseq2(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun,
2622              glue_f gluef, Lisp_Object result_type, size_t arity[])
2623 {
2624         size_t nmin = __nfam_min_size_a(seqs, nseqs, arity);
2625         /* C99 we need you */
2626         struct seq_iter_s its[nseqs];
2627         size_t aXsum = __arity_cross_sum(arity, nseqs);
2628         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2629         size_t leni =
2630                 /* leave room for stuff after us,
2631                  * we call a function on this, so leave plenty of space */
2632                 nmin * 3 < maxsz
2633                 ? nmin
2634                 : 0;
2635         Lisp_Object __vals[leni], *vals, result;
2636         struct gcpro gcpro1, gcpro2, gcpro3;
2637
2638         if (UNLIKELY(leni == 0)) {
2639                 vals = xnew_array(Lisp_Object, nmin);
2640         } else {
2641                 vals = __vals;
2642         }
2643
2644         /* initialise the value space */
2645         memset(vals, 0, nmin * sizeof(Lisp_Object));
2646         /* initialise the iterators */
2647         for (size_t i = 0; i < nseqs; i++) {
2648                 seq_iter_init((seq_t)seqs[i], &its[i]);
2649         }
2650
2651         GCPRO1nn(fun, vals, nmin, seqs, nseqs);
2652         if (UNLIKELY(NILP(fun))) {
2653                 for (size_t i = 0; i < nmin; i++) {
2654                         Lisp_Object args[aXsum];
2655                         size_t off, j;
2656
2657                         /* partially unroll this, as we know that it's
2658                          * definitely one seq to consider */
2659                         __explode_n(&its[0], (void**)&args[0], off = arity[0]);
2660                         /* ... actually we know it's even more than one
2661                          * seq otherwise we'd be in the 1seq counterpart
2662                          * of this */
2663                         __explode_n(&its[1], (void**)&args[off], arity[1]);
2664                         for (j = 2, off += arity[1];
2665                              j < nseqs; off += arity[j++]) {
2666                                 __explode_n(
2667                                         &its[j], (void**)&args[off], arity[j]);
2668                         }
2669                         vals[i] = gluef
2670                                 ? gluef(countof(args), args)
2671                                 : Flist(countof(args), args);
2672                 }
2673         } else {
2674                 for (size_t i = 0; i < nmin; i++) {
2675                         Lisp_Object args[aXsum+1];
2676                         size_t off, j;
2677
2678                         /* partially unroll this, as we know that it's
2679                          * definitely one seq to consider */
2680                         __explode_n(&its[0], (void**)&args[1], off = arity[0]);
2681                         /* ... actually we know it's even more than one
2682                          * seq otherwise we'd be in the 1seq counterpart
2683                          * of this */
2684                         __explode_n(&its[1], (void**)&args[++off], arity[1]);
2685                         for (j = 2, off += arity[1];
2686                              j < nseqs; off += arity[j++]) {
2687                                 __explode_n(
2688                                         &its[j], (void**)&args[off], arity[j]);
2689                         }
2690                         args[0] = fun;
2691                         vals[i] = Ffuncall(countof(args), args);
2692                 }
2693         }
2694         UNGCPRO;
2695
2696         /* deinitialise the iterators */
2697         for (size_t i = 0; i < nseqs; i++) {
2698                 seq_iter_fini(&its[i]);
2699         }
2700
2701         result = __dress_result(result_type, vals, nmin);
2702         if (UNLIKELY(leni == 0)) {
2703                 xfree(vals);
2704         }
2705         return result;
2706 }
2707
2708 static Lisp_Object
2709 __cart_nseq(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun, size_t arity,
2710             glue_f gf, Lisp_Object result_type)
2711 {
2712 /* defaults to arity 1,1,...,1
2713  * there is no __comb_nseq() as combinations are defined to be
2714  * (cart (comb s1) (comb s2) ...), so in the arity 1,1,...,1 case this
2715  * equals __cart_nseq() */
2716         size_t nseqsz[nseqs];
2717         size_t nsum, ncart, l = 0;
2718         size_t nsz = __nfam_cart_sum_size(&nsum, &ncart, nseqsz, seqs, nseqs);
2719         /* C99 we need you */
2720         Lisp_Object *expls[nseqs];
2721         long int idx[nseqs]; /* the multi index */
2722         Lisp_Object fc[nseqs+1], *v = &fc[1];
2723         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2724         size_t leni =
2725                 /* leave room for stuff after us,
2726                  * we call a function on this, so leave plenty of space */
2727                 nsz * 3 < maxsz
2728                 ? nsz
2729                 : 0;
2730         Lisp_Object __vals[leni], *vals, result;
2731         struct gcpro gcpro1, gcpro2, gcpro3;
2732
2733         /* catch some horst cases */
2734         if (ncart == 0) {
2735                 return __dress_result(result_type, NULL, 0);
2736         } /* actually now we ought to catch the case ncart == nsum
2737            * which is nseqs == 1 */
2738
2739         if (UNLIKELY(leni == 0)) {
2740                 vals = xnew_array(Lisp_Object, nsz);
2741         } else {
2742                 vals = __vals;
2743         }
2744
2745         /* initialise the value space */
2746         memset(vals, 0, nsz * sizeof(Lisp_Object));
2747         /* initialise the explosion pointers */
2748         expls[0] = &vals[ncart];
2749         seq_explode((void**)expls[0], nseqsz[0], (seq_t)seqs[0]);
2750         expls[1] = expls[0] + nseqsz[0];
2751         seq_explode((void**)expls[1], nseqsz[1], (seq_t)seqs[1]);
2752         for (size_t i = 2; i < nseqs; i++) {
2753                 expls[i] = expls[i-1] + nseqsz[i-1];
2754                 seq_explode((void**)expls[i], nseqsz[i], (seq_t)seqs[i]);
2755         }
2756         /* setup multiindex */
2757         memset(idx, 0, nseqs * sizeof(long int));
2758         fc[0] = fun;
2759
2760         GCPRO1nn(fun, vals, nsz, seqs, nseqs);
2761         if (LIKELY(!NILP(fun) && gf == NULL)) {
2762                 while (l < ncart) {
2763                         /* fetch the data from the explosions, p-unrolled */
2764                         v[0] = expls[0][idx[0]];
2765                         v[1] = expls[1][idx[1]];
2766                         for (size_t i = 2; i < nseqs; i++) {
2767                                 v[i] = expls[i][idx[i]];
2768                         }
2769                         /* apply fun */
2770                         vals[l++] = Ffuncall(countof(fc), fc);
2771                         /* advance the multi-index */
2772                         __advance_multi_index_2(idx, countof(idx), nseqsz);
2773                 }
2774         } else if (LIKELY(!NILP(fun))) {
2775                 while (l < ncart) {
2776                         /* fetch the data from the explosions, p-unrolled */
2777                         v[0] = expls[0][idx[0]];
2778                         v[1] = expls[1][idx[1]];
2779                         for (size_t i = 2; i < nseqs; i++) {
2780                                 v[i] = expls[i][idx[i]];
2781                         }
2782                         /* glue */
2783                         v[0] = gf(countof(idx), v);
2784                         /* apply fun */
2785                         vals[l++] = Ffuncall(2, fc);
2786                         /* advance the multi-index */
2787                         __advance_multi_index_2(idx, countof(idx), nseqsz);
2788                 }
2789         } else {
2790                 glue_f tgf = gf ? gf : Flist;
2791                 while (l < ncart) {
2792                         /* fetch the data from the explosions, p-unrolled */
2793                         v[0] = expls[0][idx[0]];
2794                         v[1] = expls[1][idx[1]];
2795                         for (size_t i = 2; i < nseqs; i++) {
2796                                 v[i] = expls[i][idx[i]];
2797                         }
2798                         /* glue */
2799                         vals[l++] = tgf(countof(idx), v);
2800                         /* advance the multi-index */
2801                         __advance_multi_index_2(idx, countof(idx), nseqsz);
2802                 }
2803         }
2804         UNGCPRO;
2805
2806         result = __dress_result(result_type, vals, ncart);
2807         if (UNLIKELY(leni == 0)) {
2808                 xfree(vals);
2809         }
2810         return result;
2811 }
2812
2813 static Lisp_Object
2814 __cart_nseq2(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun,
2815              glue_f gf, Lisp_Object result_type, size_t arity[])
2816 {
2817         size_t nseqsz[nseqs];
2818         size_t nsum, ncart, midxsz /* size of the multi index */, l = 0;
2819         size_t nsz = __nfam_cart_sum_size_a(
2820                 &nsum, &ncart, &midxsz, nseqsz, seqs, nseqs, arity);
2821         /* C99 we need you */
2822         Lisp_Object *expls[nseqs];
2823         long int idx[midxsz]; /* the multi index */
2824         Lisp_Object fc[midxsz+1], *v = &fc[1];
2825         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2826         size_t leni =
2827                 /* leave room for stuff after us,
2828                  * we call a function on this, so leave plenty of space */
2829                 nsz * 3 < maxsz
2830                 ? nsz
2831                 : 0;
2832         Lisp_Object __vals[leni], *vals, result;
2833         struct gcpro gcpro1, gcpro2, gcpro3;
2834
2835         /* catch some horst cases */
2836         if (ncart == 0) {
2837                 return __dress_result(result_type, NULL, 0);
2838         } /* actually now we ought to catch the case ncart == nsum
2839            * which is nseqs == 1 */
2840
2841         if (UNLIKELY(leni == 0)) {
2842                 vals = xnew_array(Lisp_Object, nsz);
2843         } else {
2844                 vals = __vals;
2845         }
2846
2847         /* initialise the value space */
2848         memset(vals, 0, nsz * sizeof(Lisp_Object));
2849         /* initialise the explosion pointers */
2850         expls[0] = &vals[ncart];
2851         seq_explode((void**)expls[0], nseqsz[0], (seq_t)seqs[0]);
2852         expls[1] = expls[0] + nseqsz[0];
2853         seq_explode((void**)expls[1], nseqsz[1], (seq_t)seqs[1]);
2854         for (size_t i = 2; i < nseqs; i++) {
2855                 expls[i] = expls[i-1] + nseqsz[i-1];
2856                 seq_explode((void**)expls[i], nseqsz[i], (seq_t)seqs[i]);
2857         }
2858         /* setup multiindex */
2859         memset(idx, 0, countof(idx) * sizeof(long int));
2860         fc[0] = fun;
2861
2862         GCPRO1nn(fun, vals, nsz, seqs, nseqs);
2863         if (LIKELY(!NILP(fun) && gf == NULL)) {
2864                 while (l < ncart) {
2865                         size_t slot;
2866                         /* fetch the data from the explosions, p-unrolled */
2867                         v[0] = expls[0][idx[0]];
2868                         for (slot = 1; slot < arity[0]; slot++) {
2869                                 /* offload arity[0] slots onto v */
2870                                 v[slot] = expls[0][idx[slot]];
2871                         }
2872                         /* continue with the next arity[1] slots */
2873                         v[slot] = expls[1][idx[slot]];
2874                         slot++;
2875                         for (size_t j = 1; j < arity[1]; slot++, j++) {
2876                                 v[slot] = expls[1][idx[slot]];
2877                         }
2878                         /* now the rest of the crowd */
2879                         for (size_t i = 2; i < nseqs; i++) {
2880                                 v[slot] = expls[i][idx[slot]];
2881                                 slot++;
2882                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
2883                                         v[slot] = expls[i][idx[slot]];
2884                                 }
2885                         }
2886                         /* apply fun */
2887                         vals[l++] = Ffuncall(countof(fc), fc);
2888                         /* advance the multi-index */
2889                         __advance_multi_index_3(
2890                                 idx, countof(idx), nseqsz, nseqs, arity);
2891                 }
2892         } else if (LIKELY(!NILP(fun))) {
2893                 while (l < ncart) {
2894                         size_t slot;
2895                         /* fetch the data from the explosions, p-unrolled */
2896                         v[0] = expls[0][idx[0]];
2897                         for (slot = 1; slot < arity[0]; slot++) {
2898                                 /* offload arity[0] slots onto v */
2899                                 v[slot] = expls[0][idx[slot]];
2900                         }
2901                         /* continue with the next arity[1] slots */
2902                         v[slot] = expls[1][idx[slot]];
2903                         slot++;
2904                         for (size_t j = 1; j < arity[1]; slot++, j++) {
2905                                 v[slot] = expls[1][idx[slot]];
2906                         }
2907                         /* now the rest of the crowd */
2908                         for (size_t i = 2; i < nseqs; i++) {
2909                                 v[slot] = expls[i][idx[slot]];
2910                                 slot++;
2911                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
2912                                         v[slot] = expls[i][idx[slot]];
2913                                 }
2914                         }
2915                         /* glue */
2916                         v[0] = gf(countof(idx), v);
2917                         /* apply fun */
2918                         vals[l++] = Ffuncall(2, fc);
2919                         /* advance the multi-index */
2920                         __advance_multi_index_3(
2921                                 idx, countof(idx), nseqsz, nseqs, arity);
2922                 }
2923         } else {
2924                 glue_f tgf = gf ? gf : Flist;
2925                 while (l < ncart) {
2926                         size_t slot;
2927                         /* fetch the data from the explosions, p-unrolled */
2928                         v[0] = expls[0][idx[0]];
2929                         for (slot = 1; slot < arity[0]; slot++) {
2930                                 /* offload arity[0] slots onto v */
2931                                 v[slot] = expls[0][idx[slot]];
2932                         }
2933                         /* continue with the next arity[1] slots */
2934                         v[slot] = expls[1][idx[slot]];
2935                         slot++;
2936                         for (size_t j = 1; j < arity[1]; slot++, j++) {
2937                                 v[slot] = expls[1][idx[slot]];
2938                         }
2939                         /* now the rest of the crowd */
2940                         for (size_t i = 2; i < nseqs; i++) {
2941                                 v[slot] = expls[i][idx[slot]];
2942                                 slot++;
2943                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
2944                                         v[slot] = expls[i][idx[slot]];
2945                                 }
2946                         }
2947                         /* glue */
2948                         vals[l++] = tgf(countof(idx), v);
2949                         /* advance the multi-index */
2950                         __advance_multi_index_3(
2951                                 idx, countof(idx), nseqsz, nseqs, arity);
2952                 }
2953         }
2954         UNGCPRO;
2955
2956         result = __dress_result(result_type, vals, ncart);
2957         if (UNLIKELY(leni == 0)) {
2958                 xfree(vals);
2959         }
2960         return result;
2961 }
2962
2963 static Lisp_Object
2964 __comb_nseq2(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun,
2965              glue_f gf, Lisp_Object result_type, size_t arity[])
2966 {
2967 /* this is the dodgiest one, since
2968  * comb(seq1, seq2, ..., seqn) => cart(comb(seq1), comb(seq2), ..., comb(seqn))
2969  */
2970         size_t nseqsz[nseqs];
2971         size_t nsum, ncomb, midxsz /* size of the multi index */, l = 0;
2972         /* computes the size of the cartesian set, the maximum size of
2973          * the union set and the multiplicity of the multi-index (which is the
2974          * cross sum of the arity array) returns the sum of cartesian and union,
2975          * and puts intermediately computed family sizes into nseqsz[] */
2976         size_t nsz = __nfam_comb_sum_size_a(
2977                 &nsum, &ncomb, &midxsz, nseqsz, seqs, nseqs, arity);
2978         /* C99 we need you */
2979         Lisp_Object *expls[nseqs];
2980         /* the multi indices, we have a big one, and a custom one */
2981         size_t __midx[midxsz], *midx[nseqs]; /* the multi indices */
2982         Lisp_Object fc[midxsz+1], *v = &fc[1];
2983         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
2984         size_t leni =
2985                 /* leave room for stuff after us,
2986                  * we call a function on this, so leave plenty of space */
2987                 nsz * 3 < maxsz
2988                 ? nsz
2989                 : 0;
2990         Lisp_Object __vals[leni], *vals, result;
2991         struct gcpro gcpro1, gcpro2, gcpro3;
2992
2993         /* catch some horst cases */
2994         if (ncomb == 0) {
2995                 return __dress_result(result_type, NULL, 0);
2996         } /* actually now we ought to catch the case ncart == nsum
2997            * which is nseqs == 1 */
2998
2999         if (UNLIKELY(leni == 0)) {
3000                 vals = xnew_array(Lisp_Object, nsz);
3001         } else {
3002                 vals = __vals;
3003         }
3004
3005         /* initialise the value space */
3006         memset(vals, 0, nsz * sizeof(Lisp_Object));
3007         /* initialise the explosion pointers and ... */
3008         expls[0] = &vals[ncomb];
3009         seq_explode((void**)expls[0], nseqsz[0], (seq_t)seqs[0]);
3010         expls[1] = expls[0] + nseqsz[0];
3011         seq_explode((void**)expls[1], nseqsz[1], (seq_t)seqs[1]);
3012         /* ... the multi-multi-index */
3013         midx[0] = &__midx[0];
3014         __initialise_multi_index(midx[0], arity[0]);
3015         midx[1] = &__midx[arity[0]];
3016         __initialise_multi_index(midx[1], arity[1]);
3017         /* and the rest of the explosion pointers, gosh, that's going
3018          * to be an Index War */
3019         for (size_t i = 2; i < nseqs; i++) {
3020                 expls[i] = expls[i-1] + nseqsz[i-1];
3021                 seq_explode((void**)expls[i], nseqsz[i], (seq_t)seqs[i]);
3022                 midx[i] = &__midx[arity[i-1]];
3023                 __initialise_multi_index(midx[i], arity[i]);
3024         }
3025         /* further setup */
3026         fc[0] = fun;
3027
3028         GCPRO1nn(fun, vals, nsz, seqs, nseqs);
3029         if (LIKELY(!NILP(fun) && gf == NULL)) {
3030                 while (l < ncomb) {
3031                         size_t slot;
3032                         /* fetch the data from the explosions, p-unrolled */
3033                         v[0] = expls[0][__midx[0]];
3034                         for (slot = 1; slot < arity[0]; slot++) {
3035                                 /* offload arity[0] slots onto v */
3036                                 v[slot] = expls[0][__midx[slot]];
3037                         }
3038                         /* continue with the next arity[1] slots */
3039                         v[slot] = expls[1][__midx[slot]];
3040                         slot++;
3041                         for (size_t j = 1; j < arity[1]; slot++, j++) {
3042                                 v[slot] = expls[1][__midx[slot]];
3043                         }
3044                         /* now the rest of the crowd */
3045                         for (size_t i = 2; i < nseqs; i++) {
3046                                 v[slot] = expls[i][__midx[slot]];
3047                                 slot++;
3048                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
3049                                         v[slot] = expls[i][__midx[slot]];
3050                                 }
3051                         }
3052                         /* apply fun */
3053                         vals[l++] = Ffuncall(countof(fc), fc);
3054                         /* advance the multi-index */
3055                         __advance_multi_index_4(midx, nseqsz, nseqs, arity);
3056                 }
3057         } else if (LIKELY(!NILP(fun))) {
3058                 while (l < ncomb) {
3059                         size_t slot;
3060                         /* fetch the data from the explosions, p-unrolled */
3061                         v[0] = expls[0][__midx[0]];
3062                         for (slot = 1; slot < arity[0]; slot++) {
3063                                 /* offload arity[0] slots onto v */
3064                                 v[slot] = expls[0][__midx[slot]];
3065                         }
3066                         /* continue with the next arity[1] slots */
3067                         v[slot] = expls[1][__midx[slot]];
3068                         slot++;
3069                         for (size_t j = 1; j < arity[1]; slot++, j++) {
3070                                 v[slot] = expls[1][__midx[slot]];
3071                         }
3072                         /* now the rest of the crowd */
3073                         for (size_t i = 2; i < nseqs; i++) {
3074                                 v[slot] = expls[i][__midx[slot]];
3075                                 slot++;
3076                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
3077                                         v[slot] = expls[i][__midx[slot]];
3078                                 }
3079                         }
3080                         /* glue */
3081                         v[0] = gf(countof(__midx), v);
3082                         /* apply fun */
3083                         vals[l++] = Ffuncall(2, fc);
3084                         /* advance the multi-index */
3085                         __advance_multi_index_4(midx, nseqsz, nseqs, arity);
3086                 }
3087         } else {
3088                 glue_f tgf = gf ? gf : Flist;
3089
3090                 while (l < ncomb) {
3091                         size_t slot;
3092
3093                         /* fetch the data from the explosions, p-unrolled */
3094                         v[0] = expls[0][__midx[0]];
3095                         for (slot = 1; slot < arity[0]; slot++) {
3096                                 /* offload arity[0] slots onto v */
3097                                 v[slot] = expls[0][__midx[slot]];
3098                         }
3099                         /* continue with the next arity[1] slots */
3100                         v[slot] = expls[1][__midx[slot]];
3101                         slot++;
3102                         for (size_t j = 1; j < arity[1]; slot++, j++) {
3103                                 v[slot] = expls[1][__midx[slot]];
3104                         }
3105                         /* now the rest of the crowd */
3106                         for (size_t i = 2; i < nseqs; i++) {
3107                                 v[slot] = expls[i][__midx[slot]];
3108                                 slot++;
3109                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
3110                                         v[slot] = expls[i][__midx[slot]];
3111                                 }
3112                         }
3113                         /* glue */
3114                         vals[l++] = tgf(countof(__midx), v);
3115                         /* advance the multi-index */
3116                         __advance_multi_index_4(midx, nseqsz, nseqs, arity);
3117                 }
3118         }
3119         UNGCPRO;
3120
3121         result = __dress_result(result_type, vals, ncomb);
3122         if (UNLIKELY(leni == 0)) {
3123                 xfree(vals);
3124         }
3125         return result;
3126 }
3127
3128 static Lisp_Object
3129 __perm_nseq(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun, size_t arity,
3130             glue_f gf, Lisp_Object result_type)
3131 {
3132 /* defaults to arity 1,1,...,1 */
3133         size_t nseqsz[nseqs];
3134         size_t ns, ncp, np, l = 0;
3135         size_t nsz = __nfam_perm_sum_size(&ns, &ncp, &np, nseqsz, seqs, nseqs);
3136         /* C99 we need you */
3137         Lisp_Object *expls[nseqs];
3138         long int idx[nseqs]; /* the multi index */
3139         Lisp_Object fc[nseqs+1], *v = &fc[1];
3140         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
3141         size_t leni =
3142                 /* leave room for stuff after us,
3143                  * we call a function on this, so leave plenty of space */
3144                 nsz * 3 < maxsz
3145                 ? nsz
3146                 : 0;
3147         Lisp_Object __vals[leni], *vals, result;
3148         struct gcpro gcpro1, gcpro2, gcpro3;
3149
3150         /* catch some horst cases */
3151         if (ncp == 0) {
3152                 return __dress_result(result_type, NULL, 0);
3153         } /* actually now we ought to catch the case nperm == nsum
3154            * which is nseqs == 1 */
3155
3156         if (UNLIKELY(leni == 0)) {
3157                 vals = xnew_array(Lisp_Object, nsz);
3158         } else {
3159                 vals = __vals;
3160         }
3161
3162         /* initialise the value space */
3163         memset(vals, 0, nsz * sizeof(Lisp_Object));
3164         /* initialise the explosion pointers */
3165         expls[0] = &vals[ncp];
3166         seq_explode((void**)expls[0], nseqsz[0], (seq_t)seqs[0]);
3167         expls[1] = expls[0] + nseqsz[0];
3168         seq_explode((void**)expls[1], nseqsz[1], (seq_t)seqs[1]);
3169         for (size_t i = 2; i < nseqs; i++) {
3170                 expls[i] = expls[i-1] + nseqsz[i-1];
3171                 seq_explode((void**)expls[i], nseqsz[i], (seq_t)seqs[i]);
3172         }
3173         /* setup multiindex */
3174         memset(idx, 0, nseqs * sizeof(long int));
3175         fc[0] = fun;
3176
3177         GCPRO1nn(fun, vals, nsz, seqs, nseqs);
3178         switch (nseqs) {
3179         case 2:
3180                 if (LIKELY(!NILP(fun) && gf == NULL)) {
3181                         while (l < ncp) {
3182                                 /* fetch the data from the explosions */
3183                                 v[0] = expls[0][idx[0]];
3184                                 v[1] = expls[1][idx[1]];
3185                                 l = __2perm_fun(vals, 2, v, 2, fun, l);
3186                                 /* advance the multi-index */
3187                                 __advance_multi_index_2(idx, 2, nseqsz);
3188                         }
3189
3190                 } else if (LIKELY(!NILP(fun))) {
3191                         while (l < ncp) {
3192                                 /* fetch the data from the explosions */
3193                                 v[0] = expls[0][idx[0]];
3194                                 v[1] = expls[1][idx[1]];
3195                                 l = __2perm_glue_fun(vals, 2, v, 2, fun, gf, l);
3196                                 /* advance the multi-index */
3197                                 __advance_multi_index_2(idx, 2, nseqsz);
3198                         }
3199
3200                 } else {
3201                         glue_f tgf = gf ? gf : Flist;
3202                         while (l < ncp) {
3203                                 /* fetch the data from the explosions */
3204                                 v[0] = expls[0][idx[0]];
3205                                 v[1] = expls[1][idx[1]];
3206                                 l = __2perm_glue(vals, 2, v, 2, tgf, l);
3207                                 /* advance the multi-index */
3208                                 __advance_multi_index_2(idx, 2, nseqsz);
3209                         }
3210                 }
3211                 break;
3212
3213         case 3:
3214                 if (LIKELY(!NILP(fun) && gf == NULL)) {
3215                         while (l < ncp) {
3216                                 /* fetch the data from the explosions */
3217                                 v[0] = expls[0][idx[0]];
3218                                 v[1] = expls[1][idx[1]];
3219                                 v[2] = expls[2][idx[2]];
3220                                 l = __3perm_fun(vals, 0, v, 3, fun, l);
3221                                 /* advance the multi-index */
3222                                 __advance_multi_index_2(idx, 3, nseqsz);
3223                         }
3224                 } else if (LIKELY(!NILP(fun))) {
3225                         while (l < ncp) {
3226                                 /* fetch the data from the explosions */
3227                                 v[0] = expls[0][idx[0]];
3228                                 v[1] = expls[1][idx[1]];
3229                                 v[2] = expls[2][idx[2]];
3230                                 l = __3perm_glue_fun(vals, 0, v, 3, fun, gf, l);
3231                                 /* advance the multi-index */
3232                                 __advance_multi_index_2(idx, 3, nseqsz);
3233                         }
3234                 } else {
3235                         glue_f tgf = gf ? gf : Flist;
3236                         while (l < ncp) {
3237                                 /* fetch the data from the explosions */
3238                                 v[0] = expls[0][idx[0]];
3239                                 v[1] = expls[1][idx[1]];
3240                                 v[2] = expls[2][idx[2]];
3241                                 l = __3perm_glue(vals, 0, v, 3, tgf, l);
3242                                 /* advance the multi-index */
3243                                 __advance_multi_index_2(idx, 3, nseqsz);
3244                         }
3245                 }
3246                 break;
3247
3248         default:
3249                 if (LIKELY(!NILP(fun) && gf == NULL)) {
3250                         while (l < ncp) {
3251                                 /* fetch the data from the explosions */
3252                                 v[0] = expls[0][idx[0]];
3253                                 v[1] = expls[1][idx[1]];
3254                                 for (size_t i = 2; i < nseqs; i++) {
3255                                         v[i] = expls[i][idx[i]];
3256                                 }
3257                                 /* have Sn operating */
3258                                 l = __Sn_fun(vals, np, v, nseqs, fun, l);
3259                                 /* advance the multi-index */
3260                                 __advance_multi_index_2(idx, nseqs, nseqsz);
3261                         }
3262                 } else if (LIKELY(!NILP(fun))) {
3263                         while (l < ncp) {
3264                                 /* fetch the data from the explosions */
3265                                 v[0] = expls[0][idx[0]];
3266                                 v[1] = expls[1][idx[1]];
3267                                 for (size_t i = 2; i < nseqs; i++) {
3268                                         v[i] = expls[i][idx[i]];
3269                                 }
3270                                 /* have Sn operating */
3271                                 l = __Sn_glue_fun(
3272                                         vals, np, v, nseqs, fun, gf, l);
3273                                 /* advance the multi-index */
3274                                 __advance_multi_index_2(idx, nseqs, nseqsz);
3275                         }
3276                 } else {
3277                         glue_f tgf = gf ? gf : Flist;
3278                         while (l < ncp) {
3279                                 /* fetch the data from the explosions */
3280                                 v[0] = expls[0][idx[0]];
3281                                 v[1] = expls[1][idx[1]];
3282                                 for (size_t i = 2; i < nseqs; i++) {
3283                                         v[i] = expls[i][idx[i]];
3284                                 }
3285                                 /* have Sn operating */
3286                                 l = __Sn_glue(vals, np, v, nseqs, tgf, l);
3287                                 /* advance the multi-index */
3288                                 __advance_multi_index_2(idx, nseqs, nseqsz);
3289                         }
3290                 }
3291                 break;
3292         }
3293         UNGCPRO;
3294
3295         result = __dress_result(result_type, vals, ncp);
3296         if (UNLIKELY(leni == 0)) {
3297                 xfree(vals);
3298         }
3299         return result;
3300 }
3301
3302 static Lisp_Object
3303 __perm_nseq2(Lisp_Object seqs[], size_t nseqs, Lisp_Object fun,
3304              glue_f gf, Lisp_Object result_type, size_t arity[])
3305 {
3306 /* this is the utmost dodgiest one, since
3307  * perm(seq1, seq2, ..., seqn) => perm(comb(seq1, seq2, ..., seqn))
3308  */
3309         size_t nseqsz[nseqs];
3310         size_t nsum, nvar, nperm, midxsz /* size of the multi index */, l = 0;
3311         /* computes the size of the cartesian set, the maximum size of
3312          * the union set and the multiplicity of the multi-index (which is the
3313          * cross sum of the arity array) returns the sum of cartesian and union,
3314          * and puts intermediately computed family sizes into nseqsz[] */
3315         size_t nsz = __nfam_perm_sum_size_a(
3316                 &nsum, &nvar, &nperm, &midxsz, nseqsz, seqs, nseqs, arity);
3317         /* C99 we need you */
3318         Lisp_Object *expls[nseqs];
3319         /* the multi indices, we have a big one, and a custom one */
3320         size_t __midx[midxsz], *midx[nseqs]; /* the multi indices */
3321         Lisp_Object v[midxsz + 2 /*to survive the aggressive loop unrolling*/];
3322         size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
3323         size_t leni =
3324                 /* leave room for stuff after us,
3325                  * we call a function on this, so leave plenty of space */
3326                 nsz * 3 < maxsz
3327                 ? nsz
3328                 : 0;
3329         Lisp_Object __vals[leni], *vals, result;
3330         struct gcpro gcpro1, gcpro2, gcpro3;
3331
3332         /* catch some horst cases */
3333         if (nvar == 0) {
3334                 return __dress_result(result_type, NULL, 0);
3335         } /* actually now we ought to catch the case ncart == nsum
3336            * which is nseqs == 1 */
3337
3338         if (UNLIKELY(leni == 0)) {
3339                 vals = xnew_array(Lisp_Object, nsz);
3340         } else {
3341                 vals = __vals;
3342         }
3343
3344         /* initialise the value space */
3345         memset(vals, 0, nsz * sizeof(Lisp_Object));
3346         /* initialise the explosion pointers and ... */
3347         expls[0] = &vals[nvar];
3348         seq_explode((void**)expls[0], nseqsz[0], (seq_t)seqs[0]);
3349         expls[1] = expls[0] + nseqsz[0];
3350         seq_explode((void**)expls[1], nseqsz[1], (seq_t)seqs[1]);
3351         /* ... the multi-multi-index */
3352         midx[0] = &__midx[0];
3353         __initialise_multi_index(midx[0], arity[0]);
3354         midx[1] = &__midx[arity[0]];
3355         __initialise_multi_index(midx[1], arity[1]);
3356         /* ... the multi-multi-index */
3357         midx[0] = &__midx[0];
3358         __initialise_multi_index(midx[0], arity[0]);
3359         /* and the rest of the explosion pointers, gosh, that's going
3360          * to be an Index War */
3361         for (size_t i = 2; i < nseqs; i++) {
3362                 expls[i] = expls[i-1] + nseqsz[i-1];
3363                 seq_explode((void**)expls[i], nseqsz[i], (seq_t)seqs[i]);
3364                 midx[i] = &__midx[arity[i-1]];
3365                 __initialise_multi_index(midx[i], arity[i]);
3366         }
3367
3368         GCPRO1nn(fun, vals, nsz, seqs, nseqs);
3369         /* actually we would have to distinguish between cross_sum(arity) >= 4
3370          * and == 3 and == 2, because the __Sn functions unroll at least 3
3371          * iterations, howbeit it seems to work so we stick with this for now */
3372         if (LIKELY(!NILP(fun) && gf == NULL)) {
3373                 while (l < nvar) {
3374                         size_t slot;
3375                         /* fetch the data from the explosions, p-unrolled */
3376                         v[0] = expls[0][__midx[0]];
3377                         for (slot = 1; slot < arity[0]; slot++) {
3378                                 /* offload arity[0] slots onto v */
3379                                 v[slot] = expls[0][__midx[slot]];
3380                         }
3381                         /* continue with the next arity[1] slots */
3382                         v[slot] = expls[1][__midx[slot]];
3383                         slot++;
3384                         for (size_t j = 1; j < arity[1]; slot++, j++) {
3385                                 v[slot] = expls[1][__midx[slot]];
3386                         }
3387                         /* now the rest of the crowd */
3388                         for (size_t i = 2; i < nseqs; i++) {
3389                                 v[slot] = expls[i][__midx[slot]];
3390                                 slot++;
3391                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
3392                                         v[slot] = expls[i][__midx[slot]];
3393                                 }
3394                         }
3395                         /* do the rain dance */
3396                         l = __Sn_fun(vals, nperm, v, midxsz, fun, l);
3397                         /* advance the multi-index */
3398                         __advance_multi_index_4(midx, nseqsz, nseqs, arity);
3399                 }
3400         } else if (LIKELY(!NILP(fun))) {
3401                 while (l < nvar) {
3402                         size_t slot;
3403                         /* fetch the data from the explosions, p-unrolled */
3404                         v[0] = expls[0][__midx[0]];
3405                         for (slot = 1; slot < arity[0]; slot++) {
3406                                 /* offload arity[0] slots onto v */
3407                                 v[slot] = expls[0][__midx[slot]];
3408                         }
3409                         /* continue with the next arity[1] slots */
3410                         v[slot] = expls[1][__midx[slot]];
3411                         slot++;
3412                         for (size_t j = 1; j < arity[1]; slot++, j++) {
3413                                 v[slot] = expls[1][__midx[slot]];
3414                         }
3415                         /* now the rest of the crowd */
3416                         for (size_t i = 2; i < nseqs; i++) {
3417                                 v[slot] = expls[i][__midx[slot]];
3418                                 slot++;
3419                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
3420                                         v[slot] = expls[i][__midx[slot]];
3421                                 }
3422                         }
3423                         /* do the rain dance */
3424                         l = __Sn_glue_fun(vals, nperm, v, midxsz, fun, gf, l);
3425                         /* advance the multi-index */
3426                         __advance_multi_index_4(midx, nseqsz, nseqs, arity);
3427                 }
3428         } else {
3429                 glue_f tgf = gf ? gf : Flist;
3430
3431                 while (l < nvar) {
3432                         size_t slot;
3433
3434                         /* fetch the data from the explosions, p-unrolled */
3435                         v[0] = expls[0][__midx[0]];
3436                         for (slot = 1; slot < arity[0]; slot++) {
3437                                 /* offload arity[0] slots onto v */
3438                                 v[slot] = expls[0][__midx[slot]];
3439                         }
3440                         /* continue with the next arity[1] slots */
3441                         v[slot] = expls[1][__midx[slot]];
3442                         slot++;
3443                         for (size_t j = 1; j < arity[1]; slot++, j++) {
3444                                 v[slot] = expls[1][__midx[slot]];
3445                         }
3446                         /* now the rest of the crowd */
3447                         for (size_t i = 2; i < nseqs; i++) {
3448                                 v[slot] = expls[i][__midx[slot]];
3449                                 slot++;
3450                                 for (size_t j = 1; j < arity[i]; slot++, j++) {
3451                                         v[slot] = expls[i][__midx[slot]];
3452                                 }
3453                         }
3454                         /* do the rain dance */
3455                         l = __Sn_glue(vals, nperm, v, midxsz, tgf, l);
3456                         /* advance the multi-index */
3457                         __advance_multi_index_4(midx, nseqsz, nseqs, arity);
3458                 }
3459         }
3460         UNGCPRO;
3461
3462         result = __dress_result(result_type, vals, nvar);
3463         if (UNLIKELY(leni == 0)) {
3464                 xfree(vals);
3465         }
3466         return result;
3467 }
3468
3469
3470 static inline glue_f
3471 _obtain_glue(Lisp_Object glue)
3472         __attribute__((always_inline));
3473 static inline glue_f
3474 _obtain_glue(Lisp_Object glue)
3475 {
3476         if (EQ(glue, Qlist)) {
3477                 return __Flist;
3478         } else if (EQ(glue, Qdllist)) {
3479                 return Fdllist;
3480         } else if (EQ(glue, Qvector)) {
3481                 return Fvector;
3482         } else if (EQ(glue, Qstring)) {
3483                 return Fstring;
3484         } else if (EQ(glue, Qconcat)) {
3485                 return Fconcat;
3486         } else {
3487                 return NULL;
3488         }
3489 }
3490
3491 static inline int
3492 _maybe_downgrade(Lisp_Object *arity)
3493 {
3494         bool downgrade = !NILP(*arity) && CONSP(*arity);
3495         int i = 0;
3496
3497         for (Lisp_Object tmp = *arity; CONSP(tmp); i++, tmp = XCDR(tmp)) {
3498                 if (UNLIKELY(!NATNUMP(XCAR(tmp)) || XCAR(tmp) == Qzero)) {
3499                         signal_simple_error(
3500                                 ":arity does not specify a valid multi-index",
3501                                 *arity);
3502                 } else if (XCAR(tmp) != Qone) {
3503                         downgrade = false;
3504                 }
3505         }
3506         if (LIKELY(i != 1 && !downgrade)) {
3507                 return i;
3508         } else if (UNLIKELY(i == 1)) {
3509                 *arity = XCAR(*arity);
3510                 return 0;
3511         } else if (UNLIKELY(downgrade)) {
3512                 *arity = Qnil;
3513                 return i;
3514         }
3515         /* not reached */
3516         return 0;
3517 }
3518
3519 \f
3520 DEFUN("mapfam", Fmapfam, 1, MANY, 0, /*
3521 Apply FUNCTION to elements in FAMILIES and collect the results
3522 \(somehow\).
3523
3524 Arguments are:
3525 FUNCTION &rest FAMILIES &key :result-type :mode :arity :glue
3526   :initiator :separator :terminator
3527
3528 The first argument FUNCTION is the function to use for the map.
3529 If FUNCTION is `nil' the function #\'identity or one of its glue
3530 counterparts (see :glue) is implicitly used.  This can be used
3531 to convert one family to another, see examples below.
3532
3533 The rest of the arguments are FAMILIES, where a family is a
3534 sequence \(see `sequencep'\) or a dict-like map (hash-table,
3535 skiplist, etc.).  The family types need not coincide.
3536
3537 Keys may be specified as in :key value [:key value [...]], all
3538 keys are optional and may appear anywhere.  In greater detail:
3539
3540 :result-type  specifies the container type of the result object, can be:
3541   - #'list to yield a list (default)
3542   - #'dllist to yield a dllist
3543   - #'vector to yield a vector
3544   - #'string to yield a string iff FUNCTION returns characters or
3545     integers within the character range
3546   - #'concat to yield a string iff FUNCTION returns character arrays or
3547     arrays of integers within the character range
3548   - #'bit-vector to yield a bit-vector, FUNCTION's return values will
3549     be treated 1 iff non-nil, and 0 otherwise.
3550   - 'litter or 'void  to not collect the results at all
3551   - 'inplace to modify the first family in FAMILIES by side-effect if
3552     it is a sequence, and modify the value destructively if it is a
3553     dict.  This works only in pointwise mode, see :mode.
3554
3555   Generally, the result-type is a functor (most often a constructor)
3556   to be applied on the produced output sequence.  It behaves as if the
3557   elements of the output sequence had been passed to the constructor
3558   function argument-wise.  So it can be thought of as a shortcut to
3559   \(apply #'<constructor> result-sequence\).
3560
3561   In the past result types were specified by the name of the map
3562   function which turned out to be extremely sluggish in case the
3563   result type is parametrised (i.e. passed as parameter).
3564
3565 :mode  specifies the way the arguments are passed to FUNCTION, can be:
3566   - 'pointwise or 'pntw (default): given FAMILIES consists of
3567     fam1, fam2, etc. this mode passes the first point of fam1 along
3568     with the first point of fam2 along with etc. to FUNCTION.  Hereby
3569     a point is just one element in case the family is a sequence, and
3570     a key-value pair (as two separate arguments) if family is a dict
3571     (and arity does not specify this otherwise).
3572   - 'keywise or 'keyw: like 'pointwise in case of sequences, for dicts
3573     this passes only the key cell to FUNCTION.
3574   - 'cartesian or 'cart: construct the cartesian product of the points
3575     in FAMILIES and pass the resulting tuples to FUNCTION.
3576   - 'combination or 'comb: construct the set of all combinations of
3577     the points, formally this is the set of (fixed-size) subsets of the
3578     set of points, disregarding different orders.
3579     Note: the implementation will always preserve orders though, that is
3580     the combinatorial subsets of an ordered family will be ordered wrt
3581     to the same overlying order.
3582   - 'permutation or 'perm or 'variation or 'var: construct the set of
3583     all permutations of the points (also known as variations), formally
3584     this is the set of (fixed-size) tuples arising from rearranging
3585     (different ordering) the subsets of the set of points.
3586
3587   Note: The combinatorial modes (cart, comb and perm) produce giant
3588   amounts of data (using glues) or a neverending series of function
3589   calls.  In case you are using one of the above modes and pass user
3590   input to #'mapfam or allow your users to specify their own mapping
3591   functions make sure you restrain the (size of the) input arguments.
3592
3593   To give a rough idea of the outcome sizes:
3594   family size   arity    #combinations   #permutations  #cartesians
3595         2         2            1               2               4
3596         4         2            6              12              16
3597         8         4           70            1680            4096
3598         9         4          126            3024            6561
3599         9         5          126           15120           59049
3600         9         6           84           60480          531441
3601         9         7           36          181440         4782969
3602         9         8            9          362880        43046721
3603         9         9            1          362880       387420489
3604
3605   For the number of combinations:
3606   (binomial-coefficient SIZE ARITY)
3607   For the number of permutations:
3608   (* (binomial-coeeficient SIZE ARITY) (factorial ARITY))
3609   For the number of points in the cartesian product:
3610   (^ SIZE ARITY)
3611
3612   Additional note: SXEmacs' implementation of explicit symmetric group
3613   traversal (wrt a Bruhat-like order) is currently the fastest on the
3614   planet, however it obviously cannot overcome the sheer size of large
3615   symmetric groups.  Be aware that explicit unrolling S_11 eats up at
3616   least 300 MB of RAM, unrolling S_12 requires at least 3.6 GB of RAM,
3617   for S_13 it's approx 48 GB and so on.
3618
3619   Additional note: Cartesian products are highly exponential in space
3620   and time complexity.  However, unlike permutations (symm. groups)
3621   the cartesian points can be constructed rather easily using nested
3622   loops.  So if you are just after a couple of cartesian points do not
3623   bother using mapfam to create them all and filter afterwards but
3624   directly use nested loops to create the points you need.
3625
3626 :arity  specifies how to choose and pass points from the families to
3627   FUNCTION.  The value of :arity can be a normal index (positive
3628   integer) if there is only one family, and a multi-index if points
3629   are to be picked from multiple families.
3630
3631   Defaults:
3632   - 1 if there is only one family which is not a dictionary and mode
3633     'pointwise or 'combination
3634   - 1 if there is only one family (including dictionaries) and mode is
3635     keywise
3636   - 2 if there is only one family and mode is 'cartesian
3637   - the length of the family if there is only one family and mode is
3638     'permutation
3639   - (1 1) if family is a dictionary and mode is 'pointwise or
3640     'combination
3641   - (1 1 ... 1)  if there are n families, irrespective of mode.
3642      +-+- n -+
3643     So it is '(1 1) if two families are given, '(1 1 1) for 3 families
3644     and so forth.
3645
3646   Indices, multi-indices and modes:
3647   The general multi-index form of the :arity keyword specifies how many
3648   points are taking from each family to form a glue cell which is passed
3649   directly to FUNCTION (exploded of course) if that is non-nil, and
3650   passed to the glue if that is nil.
3651   The first index in the arity multi-index list corresponds to the
3652   number of points to choose from the first family, the second one to
3653   the second family respectively and so on.
3654   An ordinary index always refers to the first family irrespective how
3655   many families have been specified.
3656
3657   The exact meaning of this multi-index depends on the mode (see also
3658   examples):
3659   - In pointwise or keywise mode, always pick this number of points
3660     or elements (consecutively), example:
3661     Let '(1 2 3 a b c) be the family and 1 its arity, the sequence of
3662     picks goes: 1, 2, 3, a, b, c.
3663     Let '(1 2 3 a b c) be the family and 2 its arity, the sequence of
3664     picks goes: [1 2], [3 a], [b c]
3665     If a cell is not formable because there are too few elements left in
3666     the family the mapping will not take place at all, so be '(1 2 3)
3667     the family and 2 its arity, the sequence of picks goes: [1 2].
3668
3669     Multiple families in pointwise or keywise mode behave similarly
3670     Be '(1 2 3) '(a b c) two families and '(1 1) the arity (which is the
3671     default arity anyway), the pick then goes: [1 a] [2 b] [3 c], which
3672     is exactly how CL's #'map behaves in this situation.
3673     Be '(1 2 3) '(a b c one-more) two families and '(1 1) the arity,
3674     then the pick sequence again is: [1 a] [2 b] [3 c].
3675     In general the family with the least elements determines the number
3676     of picks in this mode.
3677
3678     For arbitrary multi-indices the same rules hold, example:
3679     Let '(1 2 3) '(a b c one-more) be two families and '(1 2) its arity,
3680     then the pick sequence will be: [1 a b] [2 c one-more]
3681
3682   - In cartesian mode, the arity, if an ordinary index, specifies the
3683     number of cartesian copies of the first given family, example:
3684     Let [a b c] be a sequence and arity be 2, then the mapping will
3685     yield:
3686     [a a] [a b] [a c] [b a] [b b] [b c] [c a] [c b] [c c]
3687
3688     If given a multi-index the cross sum denotes the total dimension of
3689     the yield while each index specifies the number of copies of the
3690     respective family, so fundamentally each cartesian mapping can be
3691     rewritten by a multi-index consisting solely of ones and
3692     correspondingly many copies of the input families, example:
3693     Let [a b c] and [1 2 3] be two families and '(1 1) the arity, then
3694     the cartesian mode will give:
3695     [a 1] [a 2] [a 3] [b 1] [b 2] [b 3] [c 1] [c 2] [c 3]
3696     Clearly the input sequence [a b c] of arity 2 can be rewritten as
3697     two input sequences [a b c] [a b c] and arity '(1 1) and will yield
3698     the sequence shown above.
3699     Next example:
3700     Let [a b] and [1 2] be two families and '(1 2) the arity, the result
3701     would be:
3702     [a 1 1] [a 1 2] [a 2 1] [a 2 2] [b 1 1] [b 1 2] [b 2 1] [b 2 2]
3703
3704   - In combination mode, the arity, if an ordinary index, specifies the
3705     combination size, example:
3706     Let \'(1 2 3 a) be the input sequence and 2 its arity, then the
3707     sequence of picks goes:
3708     [1 2] [1 3] [1 a] [2 3] [2 a] [3 a].
3709
3710     A multi-index over several families specifies the subset sizes of
3711     each of the families.  The total combination set is then formed by
3712     taking the cartesian product of these, example:
3713     Let [1 2 3] and [a b c] be two sets and '(2 2) the considered arity,
3714     then the first family yields [1 2] [1 3] [2 3] and the second one
3715     [a b] [a c] [b c], thence the final outcome will be:
3716     [1 2 a b] [1 2 a c] [1 2 b c] [1 3 a b] [1 3 a c] [1 3 b c] ...
3717
3718     Again, the combination mode is strictly order-preserving, both
3719     the order of the families (as a sequence of families) and the order
3720     of each family will be preserved upon mapping.
3721
3722   - In permuation mode, an ordinary index as arity will specify the
3723     cardinality, read size, of the combinatorial subset which will
3724     thence be permuted.
3725     Note: the default arity for the permutation mode if just one
3726     sequence is given is the length of this sequence!
3727
3728     Example:
3729     Let \'(a b c) be a family and no arity be given, then the sequence
3730     of picks goes:
3731     [a b c] [a c b] [b a c] [b c a] [c a b] [c b a]
3732     Let "abcd" be a family and the arity be 2, then the pick sequence
3733     looks like:
3734     "ab" "ba" "ac" "ca" "ad" "da" "bc" "cb" "bd" "db" "cd" "dc"
3735
3736     Note: while order 2 and order 3 permutations look carefully
3737     constructed and easily predictable this is not true for higher order
3738     permutations!  They are specially designed to be mappable as fast as
3739     possible and seem to have no predictable pattern whatsoever, the
3740     order is based on a 1-orbit representation of the underlying
3741     symmetric group which needs merely one transposition to get from one
3742     orbit element to the next one; for details cf. source code.
3743
3744     If given a multi-index
3745     Let "abc" and "123" be two families and arity (2 2), the pick
3746     sequence is:
3747     (perms-of "ab12"), (perms-of "ab13"), (perms-of "ab23"),
3748     (perms-of "ac12"), (perms-of "ac13"), (perms-of "ac23")
3749     where #'perms-of denotes all permutations of that one give sequence,
3750     and can be implemented as (mapfam nil :mode \'perm <seq>)
3751
3752 :glue  when multiple values are to be passed to FUNCTION (or if FUNCTION
3753   is `nil' in particular) this specifies which (container) structure to
3754   use to glue them together.
3755   IOW, if FUNCTION is just a single-valued function but the family, the
3756   arity and/or the mode induce more than just one value, glue can turn
3757   so-called exploded form into a single value.  Possible constructors:
3758   - #'list (default)  to glue the arguments as lists
3759   - #'vector  to glue the arguments as vectors
3760   - #'dllist  to glue the arguments as dllists
3761   - #'string  to glue the arguments as strings, iff they are characters
3762   - #'concat  to glue the arguments as strings from character sequences
3763
3764 In pointwise and keywise mode the result sequence can be decorated:
3765
3766 :initiator  insert this object at the beginning of the output sequence
3767   only works in 'pointwise and 'keywise mode
3768
3769 :terminator  insert this object at the end of the output sequence
3770   only works in 'pointwise and 'keywise mode
3771
3772 :separator  insert this object between each pair of elements of the
3773   output sequence.  Use this to mimic a #'mapconcat-like behaviour,
3774   but this works for any sequence not just strings.
3775   only works in 'pointwise and 'keywise mode
3776
3777
3778 Examples:
3779 =========
3780 Normal mapcar-like behaviour:
3781 \(mapfam #'1+ '(1 2 3 4)\)
3782   => (2 3 4 5)
3783 \(mapfam #'1+ :result-type 'vector '(1 2 3 4)\)
3784   => [2 3 4 5]
3785 \(mapfam #'1- :result-type 'dllist [1 2 3 4]\)
3786   => (dllist 0 1 2 3)
3787
3788 Normal mapcar*-like behaviour:
3789 \(mapfam #'+ (1 2 3 4) (10 20 30 40)\)
3790   => (11 22 33 44)
3791 \(mapfam #'+ [1 2 3 4] (dllist 10 20 30 40) :result-type 'vector\)
3792   => [11 22 33 44]
3793
3794 Construct an alist from a plist:
3795 \(mapfam #'cons '(a 1 b 2 c 3) :arity 2\)
3796   => ((a . 1) (b . 2) (c . 3))
3797 \(mapfam #'list '(a 1 b 2 c 3) :arity 3 :result-type 'vector\)
3798   => [(a 1 b) (2 c 3)]
3799 \(mapfam nil '(a 1 b 2 c 3) :arity 2 :glue 'list\)
3800   => ((a 1) (b 2) (c 3))
3801 \(mapfam nil '(a 1 b 2 c 3) :arity 2 :glue 'vector :result-type 'dllist\)
3802   => (dllist [a 1] [b 2] [c 3])
3803
3804 Apply cons to 2-sets (subsets of order 2) of a list:
3805 \(mapfam #'cons :mode 'comb :arity 2 '(a b c d)\)
3806   => ((a . b) (a . c) (a . d) (b . c) (b . d) (c . d))
3807 \(mapfam #'cons :mode 'comb :arity 2 '(a b a c)\)
3808   => ((a . b) (a . a) (a . c) (b . a) (b . c) (a . c))
3809
3810 The same for 3-sets (using the automatic glue):
3811 \(mapfam nil :mode 'comb :arity 3 '(a b c d)\)
3812   => ((a b c) (a b d) (b c d))
3813 \(mapfam nil :mode 'comb :arity 3 '(a b c d) :glue 'vector\)
3814   => ([a b c] [a b d] [b c d])
3815 Note: This is exactly what `ncombs' is doing.
3816
3817 Given a tuple of elements determine all combinations of three
3818 elements thereof (the 3-sets of the the tuple):
3819 \(mapfam nil :mode 'comb :arity 3 [a b c d]\)
3820   => ((a b c) (a b d) (a c d) (b c d))
3821 \(mapfam nil :mode 'comb :arity 3 [a b c d e] :glue #'vector\)
3822   => ([a b c] [a b d] [a b e] [a c d] [a c e] [a d e]
3823   [b c d] [b c e] [b d e] [c d e])
3824
3825 Glueing the combinations of two different lists:
3826 \(mapfam nil :mode 'comb '(a b c) '(1 2)\)
3827   => ((a 1) (b 1) (c 1) (a 2) (b 2) (c 2))
3828 \(mapfam nil :mode 'comb '(a b c) '(1 2) :arity '(2 1)\)
3829   => ((a b 1) (a c 1) (b c 1) (a b 2) (a c 2) (b c 2))
3830 \(mapfam nil :mode 'comb '(a b c) '(1 2 3) :arity '(2 2)\)
3831   => ((a b 1 2) (a c 1 2) (b c 1 2)
3832       (a b 1 3) (a c 1 3) (b c 1 3)
3833       (a b 2 3) (a c 2 3) (b c 2 3))
3834
3835 Applying the plus function immediately:
3836 \(mapfam #'+ :mode 'comb '(10 20 30) '(1 2)\)
3837   => (11 21 31 12 22 32)
3838 \(mapfam #'+ :mode 'comb '(10 20 30) '(1 2) :arity '(2 1)\)
3839   => (31 41 51 22 42 52)
3840
3841 Mimicking #'mapconcat:
3842 \(mapconcat #'identity '("the" "inverse" "of" "#'split-string") " "\)
3843   => "the inverse of #'split-string"
3844 \(mapfam nil :separator " " '("the" "inverse" "of" "#'split-string")\)
3845   => ("the" " " "inverse" " " "of" " " "#'split-string")
3846 \(mapfam nil :separator " " :result-type #'concat
3847   '("the inverse of #'split-string")\)
3848   => "the inverse of #'split-string"
3849
3850 Using cartesian mode and #'concat to emulate :separator
3851 \(mapfam #'concat :result-type #'concat :mode 'cartesian
3852   '\("the" "inverse" "of" "#'split-string"\) '(" ")\)
3853   => "the inverse of #'split-string "
3854 \(mapfam #'concat :result-type #'concat :mode 'cartesian
3855   [" "] '\("the" "inverse" "of" "#'split-string"\)\)
3856   => " the inverse of #'split-string"
3857
3858 Note a separator is not exactly like doing cartesian mapping over
3859 two sequences since it affects only pairs of elements and so the
3860 last/first tuple is missing.
3861 However, pointwise mode is still use full if each pair of elements
3862 requires a `different separator'.
3863
3864 \(mapfam #'concat :result-type #'concat :mode 'pointwise
3865   '\("the" "inverse" "of" "#'split-string"\) '(" " "_" "-" "."\)\)
3866   => "the inverse_of-#'split-string."
3867
3868 */
3869       (int nargs, Lisp_Object *args))
3870 {
3871 /* this is just one, huuuuge case distinctor */
3872         Lisp_Object fun = Qnil;
3873         Lisp_Object mode = Qnil, arity = Qnil;
3874         Lisp_Object res_type = Qlist;
3875         struct decoration_s deco = {
3876                 Qnull_pointer, Qnull_pointer, Qnull_pointer
3877         };
3878         int nfams = 0, arity_len;
3879         bool found_fun_p = false;
3880         glue_f gluef = NULL;
3881
3882         /* snarf the function */
3883         if (!KEYWORDP(args[0])) {
3884                 fun = args[0];
3885                 found_fun_p = true;
3886         }
3887         /* snarf the keys and families */
3888         for (int i = found_fun_p; i < nargs; i++) {
3889                 if (EQ(args[i], Q_result_type)) {
3890                         res_type = args[++i];
3891                 } else if (EQ(args[i], Q_arity)) {
3892                         arity = args[++i];
3893                 } else if (EQ(args[i], Q_mode)) {
3894                         mode = args[++i];
3895                 } else if (EQ(args[i], Q_glue)) {
3896                         gluef = _obtain_glue(args[++i]);
3897                 } else if (EQ(args[i], Q_separator)) {
3898                         deco.sep = args[++i];
3899                 } else if (EQ(args[i], Q_initiator)) {
3900                         deco.ini = args[++i];
3901                 } else if (EQ(args[i], Q_terminator)) {
3902                         deco.ter = args[++i];
3903                 } else if (!found_fun_p) {
3904                         /* we found the function cell */
3905                         fun = args[i];
3906                         found_fun_p = true;
3907                 } else {
3908                         /* must be a family */
3909                         args[nfams++] = args[i];
3910                 }
3911         }
3912
3913         /* check the integrity of the options */
3914         /* first kick the most idiotic situations */
3915         if (nfams == 0 ||
3916             (NILP(fun) && EQ(mode, Qvoid)) ||
3917             EQ(arity, Qzero)) {
3918                 /* looks like an exphert is here */
3919                 return __dress_result(res_type, NULL, 0);
3920         }
3921         /* now, fill in default values */
3922         if (NILP(mode)) {
3923                 mode = Qpntw;
3924         }
3925         /* degrade a thoroughly fledges '(1 1 ... 1) arity to nil */
3926         arity_len = _maybe_downgrade(&arity);
3927
3928 #define POINTWISEP(mode)                                                \
3929         (EQ(mode, Qpntw) || EQ(mode, Qpointwise) || EQ(mode, Qpoints))
3930 #define KEYWISEP(mode)                                                  \
3931         (EQ(mode, Qkeyw) || EQ(mode, Qkeywise) || EQ(mode, Qkeys))
3932 #define COMBINATIONP(mode)                                              \
3933         (EQ(mode, Qcomb) || EQ(mode, Qcombination) || EQ(mode, Qcombinations))
3934 #define PERMUTATIONP(mode)                                              \
3935         (EQ(mode, Qperm) || EQ(mode, Qpermutation) || EQ(mode, Qpermutations))
3936 #define CARTESIANP(mode)                                                \
3937         (EQ(mode, Qcart) || EQ(mode, Qcartesian))
3938
3939         if (POINTWISEP(mode) && nfams == 1 && NILP(arity) && !DICTP(args[0])) {
3940                 /* the arity is not specified and it's just one sequence */
3941                 return __pntw_1seq(args[0], fun, 1UL, gluef, res_type, deco);
3942
3943         } else if (POINTWISEP(mode) && NILP(arity) && !DICTP(args[0])) {
3944                 /* the arity is not specified and it's more than one sequence */
3945                 return __pntw_nseq(args, nfams, fun, gluef, res_type);
3946
3947         } else if (KEYWISEP(mode) && nfams == 1 && NILP(arity)) {
3948                 /* the arity is not specified and it's just one sequence,
3949                  * also we dont have to care about dicts since
3950                  * keywise is specified */
3951                 return __pntw_1seq(args[0], fun, 1UL, gluef, res_type, deco);
3952
3953         } else if (KEYWISEP(mode) && NILP(arity)) {
3954                 /* the arity is not specified and it's more than one sequence,
3955                  * also we dont have to care about dicts since
3956                  * keywise is specified */
3957                 return __pntw_nseq(args, nfams, fun, gluef, res_type);
3958
3959         } else if (POINTWISEP(mode) && (nfams == 1 && NILP(arity))) {
3960                 /* the arity is not specified, it's one sequence, and it
3961                  * must be a dict, since the non-dict case was check already */
3962                 return __pntw_1dict(args[0], fun, gluef, res_type);
3963
3964         } else if (NATNUMP(arity) && (POINTWISEP(mode) || KEYWISEP(mode))) {
3965                 /* the arity is a natnum, so we consider just the
3966                  * first sequence, in case of dicts this equals keywise
3967                  * mode */
3968                 return __pntw_1seq(args[0], fun, XUINT(arity),
3969                                    gluef, res_type, deco);
3970         } else if (POINTWISEP(mode) || KEYWISEP(mode)) {
3971                 /* the most general case */
3972                 size_t a[arity_len];
3973                 volatile Lisp_Object tmp;
3974                 long int i = 0;
3975
3976                 for (i = 0, tmp = arity;
3977                      CONSP(tmp) && i < nfams && i < arity_len;
3978                      i++, tmp = XCDR(tmp)) {
3979                         a[i] = XUINT(XCAR(tmp));
3980                 }
3981                 return __pntw_nseq2(args, i, fun, gluef, res_type, a);
3982         }
3983
3984         if (COMBINATIONP(mode) && NATNUMP(arity)) {
3985                 /* the arity is a natnum, so it's just one sequence,
3986                  * if not who cares :) */
3987                 return __comb_1seq(args[0], fun, XUINT(arity),
3988                                    gluef, res_type);
3989         } else if (COMBINATIONP(mode) && (nfams == 1 && NILP(arity))) {
3990                 /* the arity is a natnum, so it's just one sequence,
3991                  * if not who cares :) */
3992                 return __comb_1seq(args[0], fun, -1UL, gluef, res_type);
3993
3994         } else if (COMBINATIONP(mode) && NILP(arity)) {
3995                 /* the arity is not specified and it's more than one sequence */
3996                 return __cart_nseq(args, nfams, fun, 1UL, gluef, res_type);
3997
3998         } else if (COMBINATIONP(mode)) {
3999                 /* the most general case */
4000                 size_t a[arity_len];
4001                 volatile Lisp_Object tmp;
4002                 long int i = 0;
4003
4004                 for (i = 0, tmp = arity;
4005                      CONSP(tmp) && i < nfams && i < arity_len;
4006                      i++, tmp = XCDR(tmp)) {
4007                         a[i] = XUINT(XCAR(tmp));
4008                 }
4009                 return __comb_nseq2(args, i, fun, gluef, res_type, a);
4010         }
4011
4012         if (CARTESIANP(mode) && NATNUMP(arity)) {
4013                 /* the arity is a natnum, so it's just one sequence,
4014                  * if not who cares :) */
4015                 return __cart_1seq(args[0], fun, XUINT(arity),
4016                                    gluef, res_type);
4017         } else if (CARTESIANP(mode) &&
4018                    (nfams == 1 && NILP(arity))) {
4019                 /* it's one sequence and arity isnt specified, go with 2 then */
4020                 return __cart_1seq(args[0], fun, 2UL, gluef, res_type);
4021
4022         } else if (CARTESIANP(mode) && NILP(arity)) {
4023                 /* the arity is not specified and it's more than one sequence */
4024                 return __cart_nseq(args, nfams, fun, 1UL, gluef, res_type);
4025
4026         } else if (CARTESIANP(mode)) {
4027                 /* the most general case */
4028                 size_t a[arity_len];
4029                 volatile Lisp_Object tmp;
4030                 long int i = 0;
4031
4032                 for (i = 0, tmp = arity;
4033                      CONSP(tmp) && i < nfams && i < arity_len;
4034                      i++, tmp = XCDR(tmp)) {
4035                         a[i] = XUINT(XCAR(tmp));
4036                 }
4037                 return __cart_nseq2(args, i, fun, gluef, res_type, a);
4038         }
4039
4040         if (PERMUTATIONP(mode) && NATNUMP(arity)) {
4041                 /* the arity is a natnum, so it's just one sequence,
4042                  * if not who cares :) */
4043                 return __perm_1seq(args[0], fun, XUINT(arity),
4044                                    gluef, res_type);
4045         } else if (PERMUTATIONP(mode) && (nfams == 1 && NILP(arity))) {
4046                 /* the arity is a natnum, so it's just one sequence,
4047                  * if not who cares :) */
4048                 return __perm_1seq(args[0], fun, -1UL, gluef, res_type);
4049
4050         } else if (PERMUTATIONP(mode) && NILP(arity)) {
4051                 /* the arity is not specified and it's more than one sequence */
4052                 return __perm_nseq(args, nfams, fun, 1UL, gluef, res_type);
4053
4054         } else if (PERMUTATIONP(mode)) {
4055                 /* the most general case */
4056                 size_t a[arity_len];
4057                 volatile Lisp_Object tmp;
4058                 long int i = 0;
4059
4060                 for (i = 0, tmp = arity;
4061                      CONSP(tmp) && i < nfams && i < arity_len;
4062                      i++, tmp = XCDR(tmp)) {
4063                         a[i] = XUINT(XCAR(tmp));
4064                 }
4065                 return __perm_nseq2(args, i, fun, gluef, res_type, a);
4066         }
4067         return Qnil;
4068 }
4069
4070 DEFUN("mapconcat", Fmapconcat, 3, 3, 0, /*
4071 Apply FUNCTION to each element of SEQUENCE, and concat the results to a string.
4072 Between each pair of results, insert SEPARATOR.
4073
4074 Each result, and SEPARATOR, should be strings.  Thus, using " " as SEPARATOR
4075 results in spaces between the values returned by FUNCTION.  SEQUENCE itself
4076 may be a list, a vector, a dllist, a bit vector, or a string.
4077 */
4078       (function, sequence, separator))
4079 {
4080         EMACS_INT len = XINT(Flength(sequence));
4081         Lisp_Object *args;
4082         Lisp_Object result;
4083         EMACS_INT i;
4084         EMACS_INT nargs = len + len - 1;
4085         int speccount = specpdl_depth();
4086
4087         if (len == 0)
4088                 return build_string("");
4089
4090         XMALLOC_OR_ALLOCA(args, nargs, Lisp_Object);
4091
4092         mapcar1(len, args, function, sequence);
4093
4094         for (i = len - 1; i >= 0; i--)
4095                 args[i + i] = args[i];
4096
4097         for (i = 1; i < nargs; i += 2)
4098                 args[i] = separator;
4099
4100         result = Fconcat(nargs, args);
4101         XMALLOC_UNBIND(args, nargs, speccount);
4102         return result;
4103 }
4104
4105 DEFUN("mapcar", Fmapcar, 2, 2, 0,       /*
4106 Apply FUNCTION to each element of SEQUENCE; return a list of the results.
4107 The result is a list of the same length as SEQUENCE.
4108 SEQUENCE may be a list, a vector, a dllist, a bit vector, or a string.
4109 */
4110       (function, sequence))
4111 {
4112         size_t len = XINT(Flength(sequence));
4113         Lisp_Object *args = NULL;
4114         Lisp_Object result;
4115         int speccount = specpdl_depth();
4116
4117         XMALLOC_OR_ALLOCA(args, len, Lisp_Object);
4118
4119         mapcar1(len, args, function, sequence);
4120
4121         result = Flist(len, args);
4122         XMALLOC_UNBIND(args, len, speccount);
4123         return result;
4124 }
4125
4126 DEFUN("mapdllist", Fmapdllist, 2, 2, 0, /*
4127 Apply FUNCTION to each element of SEQUENCE; return a dllist of the results.
4128 The result is a list of the same length as SEQUENCE.
4129 SEQUENCE may be a list, a vector, a dllist, a bit vector, or a string.
4130 */
4131       (function, sequence))
4132 {
4133         size_t len = XINT(Flength(sequence));
4134         Lisp_Object *args = NULL;
4135         Lisp_Object result;
4136         int speccount = specpdl_depth();
4137
4138         XMALLOC_OR_ALLOCA(args, len, Lisp_Object);
4139
4140         mapcar1(len, args, function, sequence);
4141
4142         result = Fdllist(len, args);
4143         XMALLOC_UNBIND(args, len, speccount);
4144         return result;
4145 }
4146
4147 DEFUN("mapvector", Fmapvector, 2, 2, 0, /*
4148 Apply FUNCTION to each element of SEQUENCE; return a vector of the results.
4149 The result is a vector of the same length as SEQUENCE.
4150 SEQUENCE may be a list, a vector, a dllist, a bit vector, or a string.
4151 */
4152       (function, sequence))
4153 {
4154         size_t len = XINT(Flength(sequence));
4155         Lisp_Object result = make_vector(len, Qnil);
4156         struct gcpro gcpro1;
4157
4158         GCPRO1(result);
4159         mapcar1(len, XVECTOR_DATA(result), function, sequence);
4160         UNGCPRO;
4161
4162         return result;
4163 }
4164
4165 DEFUN("mapc-internal", Fmapc_internal, 2, 2, 0, /*
4166 Apply FUNCTION to each element of SEQUENCE.
4167 SEQUENCE may be a list, a vector, a bit vector, or a string.
4168 This function is like `mapcar' but does not accumulate the results,
4169 which is more efficient if you do not use the results.
4170
4171 The difference between this and `mapc' is that `mapc' supports all
4172 the spiffy Common Lisp arguments.  You should normally use `mapc'.
4173 */
4174       (function, sequence))
4175 {
4176         mapcar1(XINT(Flength(sequence)), 0, function, sequence);
4177
4178         return sequence;
4179 }
4180
4181 DEFUN("mapc-inplace", Fmapc_inplace, 2, 2, 0, /*
4182 Apply FUNCTION to each element of SEQUENCE and replace the
4183 element with the result.
4184 Return the (destructively) modified sequence.
4185
4186 At the moment, SEQUENCE can be a list, a dllist, a vector,
4187 a bit-vector, or a string.
4188
4189 Containers with type restrictions -- strings or bit-vectors here --
4190 cannot handle all results of FUNCTION.  In case of bit-vectors,
4191 if the function yields `nil' or 0 the current bit is set to 0,
4192 if the function yields anything else, the bit is set to 1.
4193 Similarly in the string case any non-char result of FUNCTION sets
4194 the currently processed character to ^@ (octal value: 000).
4195 */
4196       (function, sequence))
4197 {
4198         if (0);
4199         else if (LISTP(sequence))
4200                 list_map_inplace(function, sequence);
4201         else if (DLLISTP(sequence))
4202                 dllist_map_inplace(function, sequence);
4203         else if (STRINGP(sequence))
4204                 string_map_inplace(function, sequence);
4205         else if (VECTORP(sequence))
4206                 vector_map_inplace(function, sequence);
4207         else if (BIT_VECTORP(sequence))
4208                 bit_vector_map_inplace(function, sequence);
4209
4210         return sequence;
4211 }
4212
4213 \f
4214 /* to be emodule compliant */
4215 void
4216 map_LTX_init(void)
4217 {
4218         DEFSYMBOL(Qmap);
4219         /* the keys */
4220         DEFKEYWORD(Q_mode);
4221         DEFKEYWORD(Q_glue);
4222         DEFKEYWORD(Q_arity);
4223         DEFKEYWORD(Q_result_type);
4224         DEFKEYWORD(Q_initiator);
4225         DEFKEYWORD(Q_separator);
4226         DEFKEYWORD(Q_terminator);
4227         /* symbols for result and glue */
4228         DEFSYMBOL(Qinplace);
4229         DEFSYMBOL(Qlitter);
4230         DEFSYMBOL(Qlist);
4231         DEFSYMBOL(Qdllist);
4232         DEFSYMBOL(Qvector);
4233         DEFSYMBOL(Qbit_vector);
4234         DEFSYMBOL(Qstring);
4235         DEFSYMBOL(Qconcat);
4236         /* mode symbols */
4237         DEFSYMBOL(Qpntw);
4238         DEFSYMBOL(Qpointwise);
4239         DEFSYMBOL(Qpoints);
4240         DEFSYMBOL(Qkeyw);
4241         DEFSYMBOL(Qkeywise);
4242         DEFSYMBOL(Qkeys);
4243         DEFSYMBOL(Qcomb);
4244         DEFSYMBOL(Qcombination);
4245         DEFSYMBOL(Qcombinations);
4246         DEFSYMBOL(Qperm);
4247         DEFSYMBOL(Qpermutation);
4248         DEFSYMBOL(Qpermutations);
4249         DEFSYMBOL(Qcart);
4250         DEFSYMBOL(Qcartesian);
4251         /* the super map */
4252         DEFSUBR(Fmapfam);
4253         /* special map*s, compatibility */
4254         DEFSUBR(Fmapcar);
4255         DEFSUBR(Fmapdllist);
4256         DEFSUBR(Fmapvector);
4257         DEFSUBR(Fmapc_internal);
4258         DEFSUBR(Fmapconcat);
4259         DEFSUBR(Fmapc_inplace);
4260         return;
4261 }
4262
4263 /* map.c ends here */