* Author: Sebastian Freundt <hroptatyr@sxemacs.org>
*
* This file is part of SXEmacs.
- *
+ *
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
#include "map.h"
#include "dict.h"
#include "skiplist.h"
+#include "ent/ent.h"
Lisp_Object Qmap;
Lisp_Object Q_arity, Q_result_type, Q_mode, Q_glue;
Lisp_Object ini, ter, sep;
};
-#define deco_ini(x) ((x)->ini)
-#define deco_sep(x) ((x)->sep)
-#define deco_ter(x) ((x)->ter)
-
\f
/* auxiliary */
static inline Lisp_Object
Bytecount slen = XSTRING_LENGTH(sequence);
Bufbyte *p = NULL;
Bufbyte *end = NULL;
- int speccount = specpdl_depth();
+ int speccount = specpdl_depth();
size_t i = 0;
- XMALLOC_ATOMIC_OR_ALLOCA(p, slen, Bufbyte);
- end = p + slen;
+ XMALLOC_ATOMIC_OR_ALLOCA(p, slen, Bufbyte);
+ end = p + slen;
memcpy(p, XSTRING_DATA(sequence), slen);
vals[i++] = result;
}
}
- XMALLOC_UNBIND(p, slen, speccount);
+ XMALLOC_UNBIND(p, slen, speccount);
} else if (BIT_VECTORP(sequence)) {
Lisp_Bit_Vector *v = XBIT_VECTOR(sequence);
}
UNGCPRO;
-}
+}
static void
bit_vector_map_inplace(Lisp_Object function, Lisp_Object bitvec)
static Lisp_Object
__pntw_1seq(Lisp_Object seq, Lisp_Object fun, size_t arity,
glue_f gluef, Lisp_Object result_type,
- volatile struct decoration_s *deco)
+ struct decoration_s deco)
{
size_t nseq = __fam_size(seq);
/* C99 we need you */
size_t maxsz = __sys_stk_free() / sizeof(Lisp_Object);
- size_t totlen = nseq + 2 /* for ini and ter */ +
- (deco_sep(deco) ? nseq : 0);
+ size_t totlen = nseq + 2 /* for ini and ter */ + (deco.sep ? nseq : 0);
size_t leni =
/* leave room for stuff after us,
* we call a function on this, so leave plenty of space */
}
/* start maybe with the initiator */
- if (UNLIKELY(deco_ini(deco) != Qnull_pointer)) {
- vals[len++] = deco_ini(deco);
+ if (UNLIKELY(deco.ini != Qnull_pointer)) {
+ vals[len++] = deco.ini;
}
/* explode the sequence */
- if (LIKELY(deco_sep(deco) == Qnull_pointer)) {
+ if (LIKELY(deco.sep == Qnull_pointer)) {
seqelts = &vals[len];
} else {
- seqelts = vals + (deco_sep(deco) ? nseq : 0);
+ seqelts = vals + (deco.sep ? nseq : 0);
memset(&vals[len], 0, sizeof(Lisp_Object) * nseq);
}
(void)seq_explode((void*restrict*)seqelts, nseq, (seq_t)seq);
/* fill the rest with naughts */
memset(&seqelts[nseq], 0, (totlen - len - nseq) * sizeof(Lisp_Object));
- switch (arity) {
- struct gcpro gcpro1;
- case 1:
- if (UNLIKELY(NILP(fun))) {
- if (LIKELY(deco_sep(deco) != Qnull_pointer)) {
+ if (NILP(fun)) {
+ switch (arity) {
+ case 1:
+ if (deco.sep != Qnull_pointer) {
/* weave */
for (size_t i = 0; i < nseq; i++) {
vals[len++] = seqelts[i];
- vals[len++] = deco_sep(deco);
+ vals[len++] = deco.sep;
}
/* because we dont want the last element to
* be followed by a separator */
len = nseq;
}
break;
- }
-
- GCPROn(vals, totlen);
-
- for (size_t i = 0; i < nseq; i++) {
- Lisp_Object args[2] = {fun, seqelts[i]};
- vals[len++] = Ffuncall(2, args);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- vals[len++] = deco_sep(deco);
- }
- }
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- /* strike the last separator */
- len--;
- }
-
- UNGCPRO;
- break;
-
- case 2:
- if (UNLIKELY(NILP(fun))) {
+ case 2:
/* condense the stuff */
for (size_t i = 0, bar = nseq & -2;
/* traverse to the previous even number */
vals[len++] = gluef
? gluef(2, &seqelts[i])
: list2(seqelts[i], seqelts[i+1]);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- vals[len++] = deco_sep(deco);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ vals[len++] = deco.sep;
}
}
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
/* strike the last separator */
len--;
}
break;
- }
-
- GCPROn(vals, totlen);
-
- for (size_t i = 0, bar = nseq & -2;
- /* traverse to the last even index */
- i < bar; i += 2) {
- Lisp_Object args[3] = {fun, seqelts[i], seqelts[i+1]};
- vals[len++] = Ffuncall(countof(args), args);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- vals[len++] = deco_sep(deco);
- }
- }
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- /* strike the last separator */
- len--;
- }
-
- UNGCPRO;
- break;
-
- case 3:
- if (UNLIKELY(NILP(fun))) {
+ case 3:
/* condense the stuff */
for (size_t i = 0;
/* traverse to the last 3-divisible index */
: list3(seqelts[i],
seqelts[i+1],
seqelts[i+2]);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- vals[len++] = deco_sep(deco);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ vals[len++] = deco.sep;
}
}
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
/* strike the last separator */
len--;
}
break;
- }
-
- GCPROn(vals, len);
-
- for (size_t i = 0;
- /* traverse to the last 3-divisible index */
- i+3 <= nseq; i += 3) {
- Lisp_Object args[4] = {
- fun, seqelts[i], seqelts[i+1], seqelts[i+2]};
- vals[len++] = Ffuncall(countof(args), args);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- vals[len++] = deco_sep(deco);
- }
- }
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- /* strike the last separator */
- len--;
- }
-
- UNGCPRO;
- break;
-
- default:
- if (UNLIKELY(NILP(fun))) {
+ default:
/* condense the stuff */
for (int i = 0;
/* traverse to the last sane index */
vals[len++] = gluef
? gluef(arity, &seqelts[i])
: Flist(arity, &seqelts[i]);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- vals[len++] = deco_sep(deco);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ vals[len++] = deco.sep;
}
}
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
/* kick the last one */
len--;
}
- break;
}
+ } else {
+ struct gcpro gcpro1;
+
+ switch (arity) {
+ case 1:
+ GCPROn(vals, totlen);
+
+ for (size_t i = 0; i < nseq; i++) {
+ Lisp_Object args[2] = {fun, seqelts[i]};
+ vals[len++] = Ffuncall(2, args);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ vals[len++] = deco.sep;
+ }
+ }
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ /* strike the last separator */
+ len--;
+ }
- GCPROn(vals, len);
+ UNGCPRO;
+ break;
- for (size_t i = 0;
- /* traverse to the last 3-divisible index */
- i+arity <= nseq; i += arity) {
- Lisp_Object args[arity+1];
+ case 2:
+ GCPROn(vals, totlen);
- args[0] = fun;
- args[1] = seqelts[i];
- args[2] = seqelts[i+1];
- args[3] = seqelts[i+2];
- args[4] = seqelts[i+3];
- for (size_t j = 4; j < arity; j++) {
- args[j+1] = seqelts[i+j];
+ for (size_t i = 0, bar = nseq & -2;
+ /* traverse to the last even index */
+ i < bar; i += 2) {
+ Lisp_Object args[3] = {fun, seqelts[i], seqelts[i+1]};
+ vals[len++] = Ffuncall(countof(args), args);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ vals[len++] = deco.sep;
+ }
}
- vals[len++] = Ffuncall(countof(args), args);
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- /* add separator */
- vals[len++] = deco_sep(deco);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ /* strike the last separator */
+ len--;
}
- }
- if (UNLIKELY(deco_sep(deco) != Qnull_pointer)) {
- /* kick the last one */
- len--;
- }
- UNGCPRO;
- break;
+ UNGCPRO;
+ break;
+
+ case 3:
+ GCPROn(vals, len);
+
+ for (size_t i = 0;
+ /* traverse to the last 3-divisible index */
+ i+3 <= nseq; i += 3) {
+ Lisp_Object args[4] = {
+ fun, seqelts[i], seqelts[i+1],
+ seqelts[i+2]};
+ vals[len++] = Ffuncall(countof(args), args);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ vals[len++] = deco.sep;
+ }
+ }
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ /* strike the last separator */
+ len--;
+ }
+
+ UNGCPRO;
+ break;
+
+ default:
+ GCPROn(vals, len);
+
+ for (size_t i = 0;
+ /* traverse to the last 3-divisible index */
+ i+arity <= nseq; i += arity) {
+ Lisp_Object args[arity+1];
+
+ args[0] = fun;
+ args[1] = seqelts[i];
+ args[2] = seqelts[i+1];
+ args[3] = seqelts[i+2];
+ args[4] = seqelts[i+3];
+ for (size_t j = 4; j < arity; j++) {
+ args[j+1] = seqelts[i+j];
+ }
+ vals[len++] = Ffuncall(countof(args), args);
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ /* add separator */
+ vals[len++] = deco.sep;
+ }
+ }
+ if (UNLIKELY(deco.sep != Qnull_pointer)) {
+ /* kick the last one */
+ len--;
+ }
+
+ UNGCPRO;
+ break;
+ }
}
/* top off with the terminator */
- if (UNLIKELY(deco_ter(deco) != Qnull_pointer)) {
- vals[len++] = deco_ter(deco);
+ if (UNLIKELY(deco.ter != Qnull_pointer)) {
+ vals[len++] = deco.ter;
}
result = __dress_result(result_type, vals, len);
result = __dress_result(result_type, vals, len);
if (UNLIKELY(leni == 0)) {
- xfree(vals);
+ xfree(keys);
}
return result;
}
To give a rough idea of the outcome sizes:
family size arity #combinations #permutations #cartesians
- 2 2 1 2 4
- 4 2 6 12 16
- 8 4 70 1680 4096
- 9 4 126 3024 6561
+ 2 2 1 2 4
+ 4 2 6 12 16
+ 8 4 70 1680 4096
+ 9 4 126 3024 6561
9 5 126 15120 59049
9 6 84 60480 531441
9 7 36 181440 4782969
- (1 1) if family is a dictionary and mode is 'pointwise or
'combination
- (1 1 ... 1) if there are n families, irrespective of mode.
- +-+- n -+
+ +-+- n -+
So it is '(1 1) if two families are given, '(1 1 1) for 3 families
and so forth.
Lisp_Object fun = Qnil;
Lisp_Object mode = Qnil, arity = Qnil;
Lisp_Object res_type = Qlist;
- volatile struct decoration_s deco = {
+ struct decoration_s deco = {
Qnull_pointer, Qnull_pointer, Qnull_pointer
};
int nfams = 0, arity_len;
if (POINTWISEP(mode) && nfams == 1 && NILP(arity) && !DICTP(args[0])) {
/* the arity is not specified and it's just one sequence */
- return __pntw_1seq(args[0], fun, 1UL, gluef, res_type, &deco);
+ return __pntw_1seq(args[0], fun, 1UL, gluef, res_type, deco);
} else if (POINTWISEP(mode) && NILP(arity) && !DICTP(args[0])) {
/* the arity is not specified and it's more than one sequence */
/* the arity is not specified and it's just one sequence,
* also we dont have to care about dicts since
* keywise is specified */
- return __pntw_1seq(args[0], fun, 1UL, gluef, res_type, &deco);
+ return __pntw_1seq(args[0], fun, 1UL, gluef, res_type, deco);
} else if (KEYWISEP(mode) && NILP(arity)) {
/* the arity is not specified and it's more than one sequence,
* first sequence, in case of dicts this equals keywise
* mode */
return __pntw_1seq(args[0], fun, XUINT(arity),
- gluef, res_type, &deco);
+ gluef, res_type, deco);
} else if (POINTWISEP(mode) || KEYWISEP(mode)) {
/* the most general case */
size_t a[arity_len];
result = Fconcat(nargs, args);
XMALLOC_UNBIND(args, nargs, speccount);
- return result;
+ return result;
}
DEFUN("mapcar", Fmapcar, 2, 2, 0, /*
{
size_t len = XINT(Flength(sequence));
Lisp_Object *args = NULL;
- Lisp_Object result;
+ Lisp_Object result;
int speccount = specpdl_depth();
- XMALLOC_OR_ALLOCA(args, len, Lisp_Object);
+ XMALLOC_OR_ALLOCA(args, len, Lisp_Object);
mapcar1(len, args, function, sequence);
result = Flist(len, args);
- XMALLOC_UNBIND(args, len, speccount);
- return result;
+ XMALLOC_UNBIND(args, len, speccount);
+ return result;
}
DEFUN("mapdllist", Fmapdllist, 2, 2, 0, /*
The result is a list of the same length as SEQUENCE.
SEQUENCE may be a list, a vector, a dllist, a bit vector, or a string.
*/
- (function, sequence))
+ (function, sequence))
{
size_t len = XINT(Flength(sequence));
Lisp_Object *args = NULL;
- Lisp_Object result;
+ Lisp_Object result;
int speccount = specpdl_depth();
- XMALLOC_OR_ALLOCA(args, len, Lisp_Object);
+ XMALLOC_OR_ALLOCA(args, len, Lisp_Object);
mapcar1(len, args, function, sequence);
result = Fdllist(len, args);
- XMALLOC_UNBIND(args, len, speccount);
+ XMALLOC_UNBIND(args, len, speccount);
return result;
}
projects / sxemacs / blobdiff