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