1 /****************************************************************************
2 **
3 ** This file is part of GAP, a system for computational discrete algebra.
4 **
5 ** Copyright of GAP belongs to its developers, whose names are too numerous
6 ** to list here. Please refer to the COPYRIGHT file for details.
7 **
8 ** SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 ** This file contains the functions that mainly operate on boolean lists.
11 ** Because boolean lists are just a special case of lists many things are
12 ** done in the list package.
13 **
14 ** A *boolean list* is a list that has no holes and contains only 'true' and
15 ** 'false'. For the full definition of boolean list see chapter "Boolean
16 ** Lists" in the {\GAP} Manual. Read also the section "More about Boolean
17 ** Lists" about the different internal representations of such lists.
18 **
19 ** A list that is known to be a boolean list is represented by a bag of type
20 ** 'T_BLIST', which has the following format:
21 **
22 ** +-------+-------+-------+-------+- - - -+-------+
23 ** |logical| block | block | block | | last |
24 ** |length | 0 | 1 | 2 | | block |
25 ** +-------+-------+-------+-------+- - - -+-------+
26 ** / \
27 ** .---' `-----------.
28 ** / \
29 ** +---+---+---+---+- - - -+---+---+
30 ** |bit|bit|bit|bit| |bit|bit|
31 ** | 0 | 1 | 2 | 3 | |n-1| n |
32 ** +---+---+---+---+- - - -+---+---+
33 **
34 ** The first entry is the logical length of the list, represented as a
35 ** {\GAP} immediate integer. The other entries are blocks, represented as C
36 ** unsigned long integer. Each block corresponds to <n> (usually 32)
37 ** elements of the list. The <j>-th bit (the bit corresponding to '2\^<j>')
38 ** in the <i>-th block is 1 if the element '<list>[BIPEB*<i>+<j>+1]' it
39 ** 'true' and '0' if it is 'false'. If the logical length of the boolean
40 ** list is not a multiple of BIPEB the last block will contain unused bits,
41 ** which are then zero.
42 **
43 ** Note that a list represented by a bag of type 'T_PLIST' might still be a
44 ** boolean list. It is just that the kernel does not known this.
45 **
46 ** This package consists of three parts.
47 **
48 ** The first part consists of the macros 'BIPEB', 'SIZE_PLEN_BLIST',
49 ** 'LEN_BLIST', 'SET_LEN_BLIST', 'ELM_BLIST', and 'SET_ELM_BLIST'. They
50 ** determine the representation of boolean lists.
51 ** The rest of the {\GAP} kernel uses those macros to access and modify
52 ** boolean lists.
53 **
54 ** The second part consists of the functions 'LenBlist', 'ElmBlist',
55 ** 'ElmsBlist', 'AssBlist', 'AsssBlist', 'PosBlist', 'PlainBlist',
56 ** 'IsPossBlist', 'EqBlist', and 'LtBlist'. They are the
57 ** functions required by the generic lists package. Using these functions
58 ** the other parts of the {\GAP} kernel can access and modify boolean lists
59 ** without actually being aware that they are dealing with a boolean list.
60 **
61 ** The third part consists of the functions 'IsBlistConv', 'FuncIsBlist',
62 ** 'FuncBLIST_LIST', 'FuncLIST_BLIST', 'FuncSIZE_BLIST', 'FuncIS_SUB_BLIST',
63 ** 'FuncUNITE_BLIST', 'FuncINTER_BLIST', and 'FuncSUBTR_BLIST'. These
64 ** functions make it possible to make boolean lists, either by converting a
65 ** list to a boolean list, or by computing the characteristic boolean list
66 ** of a sublist, or by computing the union, intersection or difference of
67 ** two boolean lists.
68 **
69 *N 1992/12/16 martin should have 'LtBlist'
70 */
71
72 #include "blister.h"
73
74 #include "ariths.h"
75 #include "bits_intern.h"
76 #include "bool.h"
77 #include "error.h"
78 #include "gaputils.h"
79 #include "io.h"
80 #include "lists.h"
81 #include "modules.h"
82 #include "plist.h"
83 #include "range.h"
84 #include "saveload.h"
85 #include "set.h"
86
87
88 #define RequireBlist(funcname, op) \
89 RequireArgumentCondition(funcname, op, IsBlistConv(op), \
90 "must be a boolean list")
91
92 /****************************************************************************
93 **
94 *F TypeBlist( <list> ) . . . . . . . . . . . . . . . type of a boolean list
95 **
96 ** 'TypeBlist' returns the type of a boolean list.
97 **
98 ** 'TypeBlist' is the function in 'TypeObjFuncs' for boolean lists.
99 */
100
101 /* The following are imported from the GAP level, we have one type for
102 * each blist TNUM. */
103 static Obj TYPE_BLIST_MUT;
104 static Obj TYPE_BLIST_IMM;
105 static Obj TYPE_BLIST_NSORT_MUT;
106 static Obj TYPE_BLIST_NSORT_IMM;
107 static Obj TYPE_BLIST_SSORT_MUT;
108 static Obj TYPE_BLIST_SSORT_IMM;
109 static Obj TYPE_BLIST_EMPTY_MUT;
110 static Obj TYPE_BLIST_EMPTY_IMM;
111
TypeBlist(Obj list)112 static Obj TypeBlist(Obj list)
113 {
114 /* special case for the empty blist */
115 if ( LEN_BLIST(list) == 0 ) {
116 return IS_MUTABLE_OBJ(list) ? TYPE_BLIST_EMPTY_MUT
117 : TYPE_BLIST_EMPTY_IMM;
118 } else {
119 return IS_MUTABLE_OBJ(list) ? TYPE_BLIST_MUT : TYPE_BLIST_IMM;
120 }
121 }
122
TypeBlistNSort(Obj list)123 static Obj TypeBlistNSort(Obj list)
124 {
125 /* special case for the empty blist */
126 if ( LEN_BLIST(list) == 0 ) {
127 return IS_MUTABLE_OBJ(list) ? TYPE_BLIST_EMPTY_MUT
128 : TYPE_BLIST_EMPTY_IMM;
129 } else {
130 return IS_MUTABLE_OBJ(list) ? TYPE_BLIST_NSORT_MUT
131 : TYPE_BLIST_NSORT_IMM;
132 }
133 }
134
TypeBlistSSort(Obj list)135 static Obj TypeBlistSSort(Obj list)
136 {
137 /* special case for the empty blist */
138 if ( LEN_BLIST(list) == 0 ) {
139 return IS_MUTABLE_OBJ(list) ? TYPE_BLIST_EMPTY_MUT
140 : TYPE_BLIST_EMPTY_IMM;
141 } else {
142 return IS_MUTABLE_OBJ(list) ? TYPE_BLIST_SSORT_MUT
143 : TYPE_BLIST_SSORT_IMM;
144 }
145 }
146
147 /****************************************************************************
148 **
149 *F SaveBlist( <blist> ) . . . . . . . . . . . . . . . . . . . . save a blist
150 **
151 ** The saving method for the blist tnums
152 */
SaveBlist(Obj bl)153 static void SaveBlist(Obj bl)
154 {
155 UInt i;
156 const UInt * ptr;
157
158 /* logical length */
159 SaveSubObj(CONST_ADDR_OBJ(bl)[0]);
160 ptr = CONST_BLOCKS_BLIST(bl);
161 for (i = 1; i <= NUMBER_BLOCKS_BLIST( bl ); i++ )
162 SaveUInt(*ptr++);
163 }
164
165 /****************************************************************************
166 **
167 *F LoadBlist( <blist> ) . . . . . . . . . . . . . . . . . . . . load a blist
168 **
169 ** The loading method for the blist tnums
170 */
LoadBlist(Obj bl)171 static void LoadBlist(Obj bl)
172 {
173 UInt i;
174 UInt * ptr;
175
176 /* get the length back, then NUMBER_BLOCKS_BLIST is OK */
177 ADDR_OBJ(bl)[0] = LoadSubObj();
178
179 /* Now load the real data */
180 ptr = BLOCKS_BLIST(bl);
181 for (i = 1; i <= NUMBER_BLOCKS_BLIST( bl ); i++ )
182 *ptr++ = LoadUInt();
183 }
184
185
186 /****************************************************************************
187 **
188 *F * * * * * * * * * * * * * * copy functions * * * * * * * * * * * * * * * *
189 */
190
191 /****************************************************************************
192 **
193 *F CopyBlist( <list>, <mut> ) . . . . . . . . . . . . . copy a boolean list
194 **
195 ** 'CopyBlist' returns a structural (deep) copy of the boolean list <list>,
196 ** i.e., a recursive copy that preserves the structure.
197 **
198 ** If <list> has not yet been copied, it makes a copy, leaves a forward
199 ** pointer to the copy in the first entry of the boolean list, where the
200 ** size of the boolean list usually resides, and copies all the entries. If
201 ** the boolean list has already been copied, it returns the value of the
202 ** forwarding pointer.
203 **
204 ** 'CopyBlist' is the function in 'CopyObjFuncs' for boolean lists.
205 */
206
DoCopyBlist(Obj list,Int mut)207 static Obj DoCopyBlist(Obj list, Int mut)
208 {
209 Obj copy;
210
211 /* make a copy */
212 copy = NewBag(MUTABLE_TNUM(TNUM_OBJ(list)), SIZE_OBJ(list));
213 if (!mut)
214 MakeImmutableNoRecurse(copy);
215
216 /* copy the subvalues */
217 memcpy(ADDR_OBJ(copy), CONST_ADDR_OBJ(list),
218 sizeof(UInt)*(1+NUMBER_BLOCKS_BLIST(list)));
219
220 /* return the copy */
221 return copy;
222
223 }
224
225 #if !defined(USE_THREADSAFE_COPYING)
226
CopyBlist(Obj list,Int mut)227 static Obj CopyBlist(Obj list, Int mut)
228 {
229 Obj copy;
230
231 // immutable input is handled by COPY_OBJ
232 GAP_ASSERT(IS_MUTABLE_OBJ(list));
233
234 copy = DoCopyBlist(list, mut);
235
236 /* leave a forwarding pointer */
237 PrepareCopy(list, copy);
238 return copy;
239 }
240
241 #endif // !defined(USE_THREADSAFE_COPYING)
242
243
ShallowCopyBlist(Obj list)244 static Obj ShallowCopyBlist(Obj list)
245 {
246 return DoCopyBlist(list, 1);
247 }
248
249
250 /****************************************************************************
251 **
252 *F * * * * * * * * * * * * * * list functions * * * * * * * * * * * * * * * *
253 */
254
255 /****************************************************************************
256 **
257 *F EqBlist( <listL>, <listR> ) . . . . . test if two boolean lists are equal
258 **
259 ** 'EqBlist' returns 'true' if the two boolean lists <listL> and <listR> are
260 ** equal and 'false' otherwise.
261 */
EqBlist(Obj listL,Obj listR)262 static Int EqBlist(Obj listL, Obj listR)
263 {
264 long lenL; /* length of the left operand */
265 long lenR; /* length of the right operand */
266 const UInt * ptrL; /* pointer to the left operand */
267 const UInt * ptrR; /* pointer to the right operand */
268 UInt i; /* loop variable */
269
270 /* get the lengths of the lists and compare them */
271 lenL = LEN_BLIST( listL );
272 lenR = LEN_BLIST( listR );
273 if ( lenL != lenR ) {
274 return 0L;
275 }
276
277 /* test for equality blockwise */
278 ptrL = CONST_BLOCKS_BLIST(listL);
279 ptrR = CONST_BLOCKS_BLIST(listR);
280 for ( i = (lenL+BIPEB-1)/BIPEB; 0 < i; i-- ) {
281 if ( *ptrL++ != *ptrR++ )
282 return 0L;
283 }
284
285 /* no differences found, the lists are equal */
286 return 1L;
287 }
288
289
290 /****************************************************************************
291 **
292 *F LenBlist( <list> ) . . . . . . . . . . . . . . length of a boolean list
293 **
294 ** 'LenBlist' returns the length of the boolean list <list> as a C integer.
295 **
296 ** 'LenBlist' is the function in 'LenListFuncs' for boolean lists.
297 */
LenBlist(Obj list)298 static Int LenBlist(Obj list)
299 {
300 return LEN_BLIST( list );
301 }
302
303
304 /****************************************************************************
305 **
306 *F IsbBlist( <list>, <pos> ) . . . . . test for an element of a boolean list
307 **
308 ** 'IsbBlist' returns 1 if the boolean list <list> contains an element at
309 ** the position <pos> and 0 otherwise. It is the responsibility of the
310 ** caller to ensure that <pos> is a positive integer.
311 **
312 ** 'IsbBlist' is the function in 'IsbListFuncs' for boolean lists.
313 */
IsbBlist(Obj list,Int pos)314 static Int IsbBlist(Obj list, Int pos)
315 {
316 return (pos <= LEN_BLIST(list));
317 }
318
319
320 /****************************************************************************
321 **
322 *F Elm0Blist( <list>, <pos> ) . . . . . select an element of a boolean list
323 **
324 ** 'Elm0Blist' returns the element at the position <pos> of the boolean list
325 ** <list>, or 0 if <list> has no assigned object at <pos>. It is the
326 ** responsibility of the caller to ensure that <pos> is a positive integer.
327 */
Elm0Blist(Obj list,Int pos)328 static Obj Elm0Blist(Obj list, Int pos)
329 {
330 if ( pos <= LEN_BLIST( list ) ) {
331 return ELM_BLIST( list, pos );
332 }
333 else {
334 return 0;
335 }
336 }
337
338
339 /****************************************************************************
340 **
341 *F Elm0vBlist( <list>, <pos> ) . . . . . select an element of a boolean list
342 **
343 ** 'Elm0vPlist' does the same thing than 'Elm0List', but need not check that
344 ** <pos> is less than or equal to the length of <list>, this is the
345 ** responsibility of the caller.
346 */
Elm0vBlist(Obj list,Int pos)347 static Obj Elm0vBlist(Obj list, Int pos)
348 {
349 return ELM_BLIST( list, pos );
350 }
351
352
353 /****************************************************************************
354 **
355 *F ElmBlist( <list>, <pos> ) . . . . . . select an element of a boolean list
356 **
357 ** 'ElmBlist' selects the element at position <pos> of the boolean list
358 ** <list>. It is the responsibility of the caller to ensure that <pos> is a
359 ** positive integer. An error is signalled if <pos> is larger than the
360 ** length of <list>.
361 **
362 ** 'ElmBlist' is the function in 'ElmListFuncs' for boolean lists.
363 ** 'ElmvBlist' is the function in 'ElmvListFuncs' for boolean lists.
364 */
ElmBlist(Obj list,Int pos)365 static Obj ElmBlist(Obj list, Int pos)
366 {
367
368 /* check the position */
369 if ( LEN_BLIST( list ) < pos ) {
370 ErrorMayQuit("List Element: <list>[%d] must have an assigned value",
371 pos, 0);
372 }
373
374 /* select and return the element */
375 return ELM_BLIST( list, pos );
376 }
377
378 /****************************************************************************
379 **
380 *F ElmvBlist( <list>, <pos> ) . . . . . select an element of a boolean list
381 **
382 ** 'ElmvBlist' does the same thing than 'ElmBlist', but need not check that
383 ** <pos> is less than or equal to the length of <list>, this is the
384 ** responsibility of the caller.
385 **
386 */
ElmvBlist(Obj list,Int pos)387 static Obj ElmvBlist(Obj list, Int pos)
388 {
389 /* select and return the element */
390 return ELM_BLIST( list, pos );
391 }
392
393
394 /****************************************************************************
395 **
396 *F ElmsBlist( <list>, <poss> ) . . . . select a sublist from a boolean list
397 **
398 ** 'ElmsBlist' returns a new list containing the elements at the positions
399 ** given in the list <poss> from the boolean list <list>. It is the
400 ** responsibility of the caller to ensure that <poss> is dense and contains
401 ** only positive integers. An error is signalled if an element of <poss> is
402 ** larger than the length of <list>.
403 **
404 ** 'ElmsBlist' is the function in 'ElmsListFuncs' for boolean lists.
405 */
ElmsBlist(Obj list,Obj poss)406 static Obj ElmsBlist(Obj list, Obj poss)
407 {
408 Obj elms; /* selected sublist, result */
409 Int lenList; /* length of <list> */
410 Int lenPoss; /* length of <positions> */
411 Int pos; /* <position> as integer */
412 Int inc; /* increment in a range */
413 UInt block; /* one block of <elms> */
414 UInt bit; /* one bit of a block */
415 UInt i; /* loop variable */
416
417 /* general code */
418 if ( ! IS_RANGE(poss) ) {
419
420 /* get the length of <list> */
421 lenList = LEN_BLIST( list );
422
423 /* get the length of <positions> */
424 lenPoss = LEN_LIST( poss );
425
426 /* make the result list */
427 elms = NewBag( T_BLIST, SIZE_PLEN_BLIST( lenPoss ) );
428 SET_LEN_BLIST( elms, lenPoss );
429
430 /* loop over the entries of <positions> and select */
431 block = 0; bit = 1;
432 for ( i = 1; i <= lenPoss; i++ ) {
433
434 /* get <position> */
435 Obj p = ELMW_LIST(poss, i);
436 if (!IS_INTOBJ(p)) {
437 ErrorMayQuit("List Elements: position is too large for "
438 "this type of list",
439 0L, 0L);
440 }
441 pos = INT_INTOBJ(p);
442
443 /* select the element */
444 if ( lenList < pos ) {
445 ErrorMayQuit(
446 "List Elements: <list>[%d] must have an assigned value",
447 pos, 0L);
448 }
449
450 /* assign the element into <elms> */
451 if (TEST_BIT_BLIST(list, pos))
452 block |= bit;
453 bit <<= 1;
454 if ( bit == 0 || i == lenPoss ) {
455 *BLOCK_ELM_BLIST_PTR(elms, i) = block;
456 block = 0;
457 bit = 1;
458 }
459
460 }
461
462 }
463
464 /* special code for ranges */
465 else {
466
467 /* get the length of <list> */
468 lenList = LEN_BLIST( list );
469
470 /* get the length of <positions>, the first elements, and the inc. */
471 lenPoss = GET_LEN_RANGE( poss );
472 pos = GET_LOW_RANGE( poss );
473 inc = GET_INC_RANGE( poss );
474
475 /* check that no <position> is larger than 'LEN_LIST(<list>)' */
476 if ( lenList < pos ) {
477 ErrorMayQuit(
478 "List Elements: <list>[%d] must have an assigned value", pos,
479 0);
480 }
481 if ( lenList < pos + (lenPoss-1) * inc ) {
482 ErrorMayQuit(
483 "List Elements: <list>[%d] must have an assigned value",
484 pos + (lenPoss - 1) * inc, 0);
485 }
486
487 /* make the result list */
488 elms = NewBag( T_BLIST, SIZE_PLEN_BLIST( lenPoss ) );
489 SET_LEN_BLIST( elms, lenPoss );
490
491 if (inc == 1) {
492 CopyBits(CONST_BLOCKS_BLIST(list) + ((pos - 1) / BIPEB),
493 (pos - 1) % BIPEB, BLOCKS_BLIST(elms), 0, lenPoss);
494 }
495 else {
496 /* loop over the entries of <positions> and select */
497 block = 0;
498 bit = 1;
499 for (i = 1; i <= lenPoss; i++, pos += inc) {
500
501 /* assign the element to <elms> */
502 if (TEST_BIT_BLIST(list, pos))
503 block |= bit;
504 bit <<= 1;
505 if (bit == 0 || i == lenPoss) {
506 *BLOCK_ELM_BLIST_PTR(elms, i) = block;
507 block = 0;
508 bit = 1;
509 }
510 }
511 }
512 }
513 /* return the result */
514 return elms;
515 }
516
517
518 /****************************************************************************
519 **
520 *F UnbBlist( <blist>, <pos> ) . . . . unbind an element from a boolean list
521 **
522 ** This is to avoid unpacking of the boolean list to a plain list when <pos>
523 ** is larger or equal to the length of <blist>.
524 */
UnbBlist(Obj blist,Int pos)525 static void UnbBlist(Obj blist, Int pos)
526 {
527 GAP_ASSERT(IS_MUTABLE_OBJ(blist));
528 const Int len = LEN_BLIST(blist);
529 if (len == pos) {
530 // maybe the list becomes sorted
531 CLEAR_FILTS_LIST(blist);
532 CLEAR_BIT_BLIST(blist, pos);
533 SET_LEN_BLIST(blist, len - 1);
534 }
535 else if (pos < len) {
536 PLAIN_LIST(blist);
537 UNB_LIST(blist, pos);
538 }
539 }
540
541
542 /****************************************************************************
543 **
544 *F AssBlist( <list>, <pos>, <val> ) . . . . . . . assign to a boolean list
545 **
546 ** 'AssBlist' assigns the value <val> to the boolean list <list> at the
547 ** position <pos>. It is the responsibility of the caller to ensure that
548 ** <pos> is positive, and that <val> is not 0.
549 **
550 ** 'AssBlist' is the function in 'AssListFuncs' for boolean lists.
551 **
552 ** If <pos> is less than or equal to the logical length of the boolean list
553 ** and <val> is 'true' or 'false' the assignment is done by setting the
554 ** corresponding bit. If <pos> is one more than the logical length of the
555 ** boolean list the assignment is done by resizing the boolean list if
556 ** necessary, setting the corresponding bit and incrementing the logical
557 ** length by one. Otherwise the boolean list is converted to an ordinary
558 ** list and the assignment is performed the ordinary way.
559 */
AssBlist(Obj list,Int pos,Obj val)560 void AssBlist (
561 Obj list,
562 Int pos,
563 Obj val )
564 {
565 /* if <pos> is less than the logical length and <elm> is 'true' */
566 if ( pos <= LEN_BLIST(list) && val == True ) {
567 SET_BIT_BLIST(list, pos);
568 CLEAR_FILTS_LIST(list);
569 }
570
571 /* if <i> is less than the logical length and <elm> is 'false' */
572 else if ( pos <= LEN_BLIST(list) && val == False ) {
573 CLEAR_BIT_BLIST(list, pos);
574 CLEAR_FILTS_LIST(list);
575 }
576
577 /* if <i> is one more than the logical length and <elm> is 'true' */
578 else if ( pos == LEN_BLIST(list)+1 && val == True ) {
579 if ( SIZE_OBJ(list) < SIZE_PLEN_BLIST(pos) )
580 ResizeBag( list, SIZE_PLEN_BLIST(pos) );
581 SET_LEN_BLIST( list, pos );
582 SET_BIT_BLIST(list, pos);
583 CLEAR_FILTS_LIST(list);
584 }
585
586 /* if <i> is one more than the logical length and <elm> is 'false' */
587 else if ( pos == LEN_BLIST(list)+1 && val == False ) {
588 if ( SIZE_OBJ(list) < SIZE_PLEN_BLIST(pos) )
589 ResizeBag( list, SIZE_PLEN_BLIST(pos) );
590 SET_LEN_BLIST( list, pos );
591 CLEAR_BIT_BLIST(list, pos);
592 CLEAR_FILTS_LIST(list);
593 }
594
595 /* otherwise convert to ordinary list and assign as in 'AssList' */
596 else {
597 PLAIN_LIST(list);
598 CLEAR_FILTS_LIST(list);
599 if ( LEN_PLIST(list) < pos ) {
600 GROW_PLIST( list, (UInt)pos );
601 SET_LEN_PLIST( list, pos );
602 }
603 SET_ELM_PLIST( list, pos, val );
604 CHANGED_BAG( list );
605 }
606 }
607
608
609 /****************************************************************************
610 **
611 *F PosBlist( <list>, <val>, <start> ) position of an elm in a boolean list
612 **
613 ** 'PosBlist' returns the position of the first occurrence of the value
614 ** <val>, which may be an object of arbitrary type, in the boolean list
615 ** <list> after <start> as a C integer. If <val> does not occur in <list>
616 ** after <start>, then 0 is returned.
617 **
618 ** 'PosBlist' is the function in 'PosListFuncs' for boolean lists.
619 */
PosBlist(Obj list,Obj val,Obj start)620 static Obj PosBlist(Obj list, Obj val, Obj start)
621 {
622 Int len; /* logical length of the list */
623 const UInt * ptr; /* pointer to the blocks */
624 UInt i, j; /* loop variables */
625 UInt istart;
626 UInt firstblock, lastblock;
627 UInt firstoffset, lastoffset;
628 UInt x;
629
630 if (!IS_INTOBJ(start))
631 return Fail;
632
633 istart = INT_INTOBJ(start);
634
635 len = LEN_BLIST(list);
636
637 /* look just beyond end */
638 if ( len == istart ) {
639 return Fail;
640 }
641
642 ptr = CONST_BLOCKS_BLIST(list);
643 firstblock = istart/BIPEB;
644 lastblock = (len-1)/BIPEB;
645 firstoffset = istart%BIPEB;
646 lastoffset = (len-1)%BIPEB;
647
648 /* look for 'true' */
649 if ( val == True ) {
650
651 x = ptr[firstblock];
652 if (firstblock == lastblock)
653 {
654 if (x != 0)
655 for (j = firstoffset; j <= lastoffset; j++)
656 if ((x & (1UL << j)) != 0)
657 return INTOBJ_INT(BIPEB*firstblock + j + 1);
658 return Fail;
659 }
660 if (x != 0)
661 for (j = firstoffset; j < BIPEB; j++)
662 if ((x & (1UL << j)) != 0)
663 return INTOBJ_INT(BIPEB*firstblock + j + 1);
664 for (i = firstblock + 1; i < lastblock; i++)
665 {
666 x = ptr[i];
667 if (x != 0)
668 for (j = 0; j < BIPEB; j++)
669 if ((x & (1UL << j)) != 0)
670 return INTOBJ_INT(BIPEB*i + j + 1);
671 }
672 x = ptr[lastblock];
673 if (x != 0)
674 for (j = 0; j <= lastoffset; j++)
675 if ((x & (1UL << j)) != 0)
676 return INTOBJ_INT(BIPEB*lastblock + j + 1);
677 return Fail;
678 }
679
680 /* look for 'false' */
681 else if ( val == False ) {
682 x = ptr[firstblock];
683 if (firstblock == lastblock)
684 {
685 if (x != ~0UL)
686 for (j = firstoffset; j <= lastoffset; j++)
687 if ((x & (1UL << j)) == 0)
688 return INTOBJ_INT(BIPEB*firstblock + j + 1);
689 return Fail;
690 }
691 if (x != ~0UL)
692 for (j = firstoffset; j < BIPEB; j++)
693 if ((x & (1UL << j)) == 0)
694 return INTOBJ_INT(BIPEB*firstblock + j + 1);
695 for (i = firstblock + 1; i < lastblock; i++)
696 {
697 x = ptr[i];
698 if (x != ~0UL)
699 for (j = 0; j < BIPEB; j++)
700 if ((x & (1UL << j)) == 0)
701 return INTOBJ_INT(BIPEB*i + j + 1);
702 }
703 x = ptr[lastblock];
704 if (x != ~0UL)
705 for (j = 0; j <= lastoffset; j++)
706 if ((x & (1UL << j)) == 0)
707 return INTOBJ_INT(BIPEB*lastblock + j + 1);
708 return Fail;
709 }
710
711 /* look for something else */
712 else {
713 return Fail;
714 }
715
716 }
717
718
719 /****************************************************************************
720 **
721 *F PlainBlist( <list> ) . . . convert a boolean list into an ordinary list
722 **
723 ** 'PlainBlist' converts the boolean list <list> to a plain list.
724 **
725 ** 'PlainBlist' is the function in 'PlainListFuncs' for boolean lists.
726 */
PlainBlist(Obj list)727 static void PlainBlist(Obj list)
728 {
729 Int len; /* length of <list> */
730 UInt i; /* loop variable */
731
732 /* resize the list and retype it, in this order */
733 len = LEN_BLIST(list);
734 RetypeBagSM( list, T_PLIST );
735 GROW_PLIST( list, (UInt)len );
736 SET_LEN_PLIST( list, len );
737
738 /* replace the bits by 'True' or 'False' as the case may be */
739 /* this must of course be done from the end of the list backwards */
740 for ( i = len; 0 < i; i-- )
741 SET_ELM_PLIST(list, i, ELM_BLIST(list, i));
742
743 /* 'CHANGED_BAG' not needed, 'True' and 'False' are safe */
744 }
745
746
747
748 /****************************************************************************
749 **
750 *F IsPossBlist( <list> ) . . positions list test function for boolean lists
751 **
752 ** 'IsPossBlist' returns 1 if <list> is empty, and 0 otherwise, since a
753 ** boolean list is a positions list if and only if it is empty.
754 */
IsPossBlist(Obj list)755 static Int IsPossBlist(Obj list)
756 {
757 return LEN_BLIST(list) == 0;
758 }
759
760
761 /****************************************************************************
762 **
763 *F IsHomogBlist( <list> ) . . . . . . . . . . check if <list> is homogenous
764 */
IsHomogBlist(Obj list)765 static Int IsHomogBlist(Obj list)
766 {
767 return (0 < LEN_BLIST(list));
768 }
769
770
771 /****************************************************************************
772 **
773 *F IsSSortBlist( <list> ) . . . . . . . check if <list> is strictly sorted
774 */
IsSSortBlist(Obj list)775 static Int IsSSortBlist(Obj list)
776 {
777 Int isSort;
778
779 if ( LEN_BLIST(list) <= 1 ) {
780 isSort = 1;
781 }
782 else if ( LEN_BLIST(list) == 2 ) {
783 isSort = (TEST_BIT_BLIST(list, 1) && !TEST_BIT_BLIST(list, 2));
784 }
785 else {
786 isSort = 0;
787 }
788 SET_FILT_LIST( list, (isSort ? FN_IS_SSORT : FN_IS_NSORT) );
789
790 return isSort;
791 }
792
793
794 /****************************************************************************
795 **
796 *F ConvBlist( <list> ) . . . . . . . . . convert a list into a boolean list
797 **
798 ** `ConvBlist' changes the representation of boolean lists into the compact
799 ** representation of type 'T_BLIST' described above.
800 */
ConvBlist(Obj list)801 void ConvBlist (
802 Obj list )
803 {
804 Int len; /* logical length of the list */
805 UInt block; /* one block of the boolean list */
806 UInt bit; /* one bit of a block */
807 UInt i; /* loop variable */
808
809 /* if <list> is known to be a boolean list, it is very easy */
810 if ( IS_BLIST_REP(list) ) {
811 return;
812 }
813
814 /* change its representation */
815 block = 0;
816 bit = 1;
817 len = LEN_LIST( list );
818 for ( i = 1; i <= len; i++ ) {
819 if ( ELMW_LIST( list, (Int)i ) == True )
820 block |= bit;
821 bit = bit << 1;
822 if ( bit == 0 || i == len ) {
823 *BLOCK_ELM_BLIST_PTR(list, i) = block;
824 block = 0;
825 bit = 1;
826 }
827 }
828 RetypeBagSM( list, T_BLIST );
829 ResizeBag( list, SIZE_PLEN_BLIST(len) );
830 SET_LEN_BLIST( list, len );
831 }
832
833 /****************************************************************************
834 **
835 *F COUNT_TRUES_BLOCK( <block> ) . . . . . . . . . . . count number of trues
836 */
COUNT_TRUES_BLOCK(UInt block)837 UInt COUNT_TRUES_BLOCK(UInt block)
838 {
839 #if USE_POPCNT && defined(HAVE___BUILTIN_POPCOUNTL)
840 return __builtin_popcountl(block);
841 #else
842 #ifdef SYS_IS_64_BIT
843 block =
844 (block & 0x5555555555555555L) + ((block >> 1) & 0x5555555555555555L);
845 block =
846 (block & 0x3333333333333333L) + ((block >> 2) & 0x3333333333333333L);
847 block = (block + (block >> 4)) & 0x0f0f0f0f0f0f0f0fL;
848 block = (block + (block >> 8));
849 block = (block + (block >> 16));
850 block = (block + (block >> 32)) & 0x00000000000000ffL;
851 #else
852 block = (block & 0x55555555) + ((block >> 1) & 0x55555555);
853 block = (block & 0x33333333) + ((block >> 2) & 0x33333333);
854 block = (block + (block >> 4)) & 0x0f0f0f0f;
855 block = (block + (block >> 8));
856 block = (block + (block >> 16)) & 0x000000ff;
857 #endif
858 return block;
859 #endif
860 }
861
862 /****************************************************************************
863 **
864 *F COUNT_TRUES_BLOCKS( <ptr>, <nblocks> )
865 */
COUNT_TRUES_BLOCKS(const UInt * ptr,UInt nblocks)866 UInt COUNT_TRUES_BLOCKS(const UInt * ptr, UInt nblocks)
867 {
868 UInt n = 0;
869 while (nblocks >= 4) {
870 UInt n1 = COUNT_TRUES_BLOCK(*ptr++);
871 UInt n2 = COUNT_TRUES_BLOCK(*ptr++);
872 UInt n3 = COUNT_TRUES_BLOCK(*ptr++);
873 UInt n4 = COUNT_TRUES_BLOCK(*ptr++);
874 n += n1 + n2 + n3 + n4;
875 nblocks -= 4;
876 }
877 while (nblocks) {
878 n += COUNT_TRUES_BLOCK(*ptr++);
879 nblocks--;
880 }
881 // return the number of bits
882 return n;
883 }
884
885 /****************************************************************************
886 **
887 *F IsBlist( <list> ) . . . . . . . . . test whether a list is a boolean list
888 **
889 ** 'IsBlist' returns 1 if the list <list> is a boolean list, i.e., a
890 ** list that has no holes and contains only 'true' and 'false', and 0
891 ** otherwise.
892 */
IsBlist(Obj list)893 static Int IsBlist(Obj list)
894 {
895 UInt isBlist; /* result of the test */
896 Int len; /* logical length of the list */
897 UInt i; /* loop variable */
898
899 /* if <list> is known to be a boolean list, it is very easy */
900 if ( IS_BLIST_REP(list) ) {
901 isBlist = 1;
902 }
903
904 /* if <list> is not a small list, it isn't a boolean list (convert to list) */
905 else if ( ! IS_SMALL_LIST( list ) ) {
906 isBlist = 0;
907 }
908
909 /* otherwise test if there are holes and if all elements are boolean */
910 else {
911
912 /* test that all elements are bound and either 'true' or 'false' */
913 len = LEN_LIST( list );
914 for ( i = 1; i <= len; i++ ) {
915 if ( ELMV0_LIST( list, (Int)i ) == 0
916 || (ELMW_LIST( list, (Int)i ) != True
917 && ELMW_LIST( list, (Int)i ) != False) ) {
918 break;
919 }
920 }
921
922 isBlist = (len < i);
923 }
924
925 /* return the result */
926 return isBlist;
927 }
928
929
930 /****************************************************************************
931 **
932 *F IsBlistConv( <list> ) . test whether a list is a boolean list and convert
933 **
934 ** 'IsBlistConv' returns 1 if the list <list> is a boolean list, i.e., a
935 ** list that has no holes and contains only 'true' and 'false', and 0
936 ** otherwise. As a side effect 'IsBlistConv' changes the representation of
937 ** boolean lists into the compact representation of type 'T_BLIST' described
938 ** above.
939 */
IsBlistConv(Obj list)940 static Int IsBlistConv(Obj list)
941 {
942 UInt isBlist; /* result of the test */
943 Int len; /* logical length of the list */
944 UInt i; /* loop variable */
945
946 /* if <list> is known to be a boolean list, it is very easy */
947 if ( IS_BLIST_REP(list) ) {
948 isBlist = 1;
949 }
950
951 /* if <list> is not a list, it isn't a boolean list (convert to list) */
952 else if ( ! IS_SMALL_LIST(list) ) {
953 isBlist = 0;
954 }
955
956 /* otherwise test if there are holes and if all elements are boolean */
957 else {
958
959 /* test that all elements are bound and either 'true' or 'false' */
960 len = LEN_LIST( list );
961 for ( i = 1; i <= len; i++ ) {
962 Obj elm = ELMV0_LIST( list, (Int)i );
963 if ( elm == 0 || (elm != True && elm != False) ) {
964 break;
965 }
966 }
967
968 /* if <list> is a boolean list, change its representation */
969 isBlist = (len < i);
970 if ( isBlist ) {
971 ConvBlist(list);
972 }
973 }
974
975 /* return the result */
976 return isBlist;
977 }
978
979
980 /****************************************************************************
981 **
982 *F SizeBlist( <blist> ) . . . . number of 'true' entries in a boolean list
983 **
984 ** 'SizeBlist' returns the number of entries of the boolean list <blist>
985 ** that are 'true'.
986 **
987 ** The work is done in `COUNT_TRUES_BLOCKS` in blister.h and the algorithms
988 ** are documented there.
989 */
SizeBlist(Obj blist)990 static UInt SizeBlist(Obj blist)
991 {
992 const UInt * ptr; /* pointer to blist */
993 UInt nrb; /* number of blocks in blist */
994
995 /* get the number of blocks and a pointer */
996 nrb = NUMBER_BLOCKS_BLIST(blist);
997 ptr = CONST_BLOCKS_BLIST(blist);
998
999 return COUNT_TRUES_BLOCKS( ptr, nrb);
1000 }
1001
1002
1003 /****************************************************************************
1004 **
1005 *F * * * * * * * * * * * * * * GAP level functions * * * * * * * * * * * * *
1006 */
1007
1008 /****************************************************************************
1009 **
1010 *F FiltIS_BLIST( <self>, <val> ) . . . . . test if a value is a boolean list
1011 **
1012 ** 'FiltIS_BLIST' handles the internal function 'IsBlist'.
1013 **
1014 ** 'IsBlist( <val> )'
1015 **
1016 ** 'IsBlist' returns 'true' if the value <val> is a boolean list and 'false'
1017 ** otherwise. A value is a boolean list if it is a lists without holes
1018 ** containing only 'true' and 'false'.
1019 */
1020 static Obj IsBlistFilt;
1021
FiltIS_BLIST(Obj self,Obj val)1022 static Obj FiltIS_BLIST(Obj self, Obj val)
1023 {
1024 /* let 'IsBlist' do the work */
1025 return IsBlist( val ) ? True : False;
1026 }
1027
1028
1029 /****************************************************************************
1030 **
1031 *F FuncIS_BLIST_CONV( <self>, <val> ) . . test if a value is a boolean list
1032 **
1033 ** 'FuncIS_BLIST_CONV' handles the internal function 'IsBlist'.
1034 **
1035 ** 'IsBlistConv( <val> )'
1036 **
1037 ** 'IsBlist' returns 'true' if the value <val> is a boolean list and 'false'
1038 ** otherwise. A value is a boolean list if it is a lists without holes
1039 ** containing only 'true' and 'false'.
1040 */
FuncIS_BLIST_CONV(Obj self,Obj val)1041 static Obj FuncIS_BLIST_CONV(Obj self, Obj val)
1042 {
1043 // let 'IsBlistConv' do the work
1044 return IsBlistConv( val ) ? True : False;
1045 }
1046
1047
1048 /****************************************************************************
1049 **
1050 **
1051 *F FiltIS_BLIST_REP( <self>, <obj> ) . . test if value is a boolean list rep
1052 */
1053 static Obj IsBlistRepFilt;
1054
FiltIS_BLIST_REP(Obj self,Obj obj)1055 static Obj FiltIS_BLIST_REP(Obj self, Obj obj)
1056 {
1057 return (IS_BLIST_REP( obj ) ? True : False);
1058 }
1059
1060
1061 /****************************************************************************
1062 **
1063 *F FuncSIZE_BLIST( <self>, <blist> ) . . number of 'true' entries in <blist>
1064 **
1065 ** 'FuncSIZE_BLIST' implements the internal function 'SizeBlist'
1066 */
FuncSIZE_BLIST(Obj self,Obj blist)1067 static Obj FuncSIZE_BLIST(Obj self, Obj blist)
1068 {
1069 RequireBlist("SizeBlist", blist);
1070 return INTOBJ_INT(SizeBlist(blist));
1071 }
1072
1073
1074 /****************************************************************************
1075 **
1076 *F FuncBLIST_LIST( <self>, <list>, <sub> ) make boolean list from a sublist
1077 **
1078 ** 'FuncBLIST_LIST' implements the internal function 'BlistList'.
1079 **
1080 ** 'BlistList( <list>, <sub> )'
1081 **
1082 ** 'BlistList' creates a boolean list that describes the list <sub> as
1083 ** sublist of the list <list>. The result is a new boolean list <blist>,
1084 ** which has the same length as <list>, such that '<blist>[<i>]' is 'true'
1085 ** if '<list>[<i>]' is an element of <sub> and 'false' otherwise.
1086 **
1087 ** 'BlistList' is most effective if <list> is a set, but can be used with an
1088 ** arbitrary list that has no holes.
1089 */
1090
1091 static Obj FuncUNITE_BLIST_LIST(Obj self, Obj list, Obj blist, Obj sub);
1092
FuncBLIST_LIST(Obj self,Obj list,Obj sub)1093 static Obj FuncBLIST_LIST(Obj self, Obj list, Obj sub)
1094 {
1095 RequireSmallList("BlistList", list);
1096 RequireSmallList("BlistList", sub);
1097
1098 Int lenList = LEN_LIST( list );
1099 Obj blist = NewBag( T_BLIST, SIZE_PLEN_BLIST( lenList ) );
1100 SET_LEN_BLIST(blist, lenList);
1101
1102 FuncUNITE_BLIST_LIST(self, list, blist, sub);
1103
1104 return blist;
1105 }
1106
1107
1108 /****************************************************************************
1109 **
1110 *F FuncLIST_BLIST( <self>, <list>, <blist> ) . make a sublist from a <blist>
1111 **
1112 ** 'FuncListBlist' implements the internal function 'ListBlist'.
1113 **
1114 ** 'ListBlist( <list>, <blist> )'
1115 **
1116 ** 'ListBlist' returns the sublist of the elements of the list <list> for
1117 ** which the boolean list <blist>, which must have the same length as
1118 ** <list>, contains 'true'. The order of the elements in the result is the
1119 ** same as in <list>.
1120 **
1121 */
FuncLIST_BLIST(Obj self,Obj list,Obj blist)1122 static Obj FuncLIST_BLIST(Obj self, Obj list, Obj blist)
1123 {
1124 Obj sub; /* handle of the result */
1125 Int len; /* logical length of the list */
1126 UInt n; /* number of bits in blist */
1127 UInt nn;
1128 UInt i; /* loop variable */
1129
1130 RequireSmallList("ListBlist", list);
1131 RequireBlist("ListBlist", blist);
1132 RequireSameLength("ListBlist", blist, list);
1133
1134 /* compute the number of 'true'-s */
1135 n = SizeBlist(blist);
1136
1137 /* make the sublist (we now know its size exactly) */
1138 sub = NEW_PLIST_WITH_MUTABILITY( IS_MUTABLE_OBJ(list), T_PLIST, n );
1139 SET_LEN_PLIST( sub, n );
1140
1141 /* loop over the boolean list and stuff elements into <sub> */
1142 len = LEN_LIST( list );
1143 nn = 1;
1144 for ( i = 1; nn <= n && i <= len; i++ ) {
1145 if (TEST_BIT_BLIST(blist, i)) {
1146 SET_ELM_PLIST( sub, (Int)nn, ELMW_LIST( list, (Int)i ) );
1147 CHANGED_BAG( sub );
1148 nn++;
1149 }
1150 }
1151
1152 /* return the sublist */
1153 return sub;
1154 }
1155
1156
1157 /****************************************************************************
1158 **
1159 *F FuncPositionNthTrueBlist( <self>, <blist>, <Nth> ) . . . find true value
1160 **
1161 */
FuncPositionNthTrueBlist(Obj self,Obj blist,Obj Nth)1162 static Obj FuncPositionNthTrueBlist(
1163
1164 Obj self, Obj blist, Obj Nth)
1165 {
1166 UInt nrb;
1167 Int pos, i;
1168 UInt m, mask;
1169 const UInt * ptr;
1170
1171 /* Check the arguments. */
1172 RequireBlist("ListBlist", blist);
1173 Int nth = GetPositiveSmallIntEx("Position", Nth, "<nth>");
1174
1175 nrb = NUMBER_BLOCKS_BLIST(blist);
1176 if ( ! nrb ) return Fail;
1177 pos = 0;
1178 ptr = CONST_BLOCKS_BLIST(blist);
1179 i = 1;
1180 m = COUNT_TRUES_BLOCK(*ptr);
1181 while ( nth > m ) {
1182 if ( ++i > nrb ) return Fail;
1183 nth -= m;
1184 pos += BIPEB;
1185 ptr++;
1186 m = COUNT_TRUES_BLOCK(*ptr);
1187 }
1188 m = *ptr;
1189 mask = 0x1;
1190 while ( nth > 0 ) {
1191 pos++;
1192 if ( m & mask ) nth--;
1193 mask <<= 1;
1194 }
1195 return INTOBJ_INT( pos );
1196 }
1197
1198
1199 /****************************************************************************
1200 **
1201 *F FuncIsSubsetBlist( <self>, <blist1>, <blist2> ) . . . . . . . subset test
1202 **
1203 ** 'FuncIsSubsetBlist' implements the internal function 'IsSubsetBlist'.
1204 **
1205 ** 'IsSubsetBlist( <blist1>, <blist2> )'
1206 **
1207 ** 'IsSubsetBlist' returns 'true' if the boolean list <blist2> is a subset
1208 ** of the boolean list <blist1>, which must have equal length. <blist2>
1209 ** is a subset of <blist1> if '<blist2>[<i>] >= <blist1>[<i>]' for all <i>.
1210 */
FuncIS_SUB_BLIST(Obj self,Obj blist1,Obj blist2)1211 static Obj FuncIS_SUB_BLIST(Obj self, Obj blist1, Obj blist2)
1212 {
1213 const UInt * ptr1; /* pointer to the first argument */
1214 const UInt * ptr2; /* pointer to the second argument */
1215 UInt i; /* loop variable */
1216
1217 RequireBlist("IsSubsetBlist", blist1);
1218 RequireBlist("IsSubsetBlist", blist2);
1219 RequireSameLength("IsSubsetBlist", blist1, blist2);
1220
1221 /* test for subset property blockwise */
1222 ptr1 = CONST_BLOCKS_BLIST(blist1);
1223 ptr2 = CONST_BLOCKS_BLIST(blist2);
1224
1225 for ( i = NUMBER_BLOCKS_BLIST(blist1); 0 < i; i-- ) {
1226 if ( *ptr1 != (*ptr1 | *ptr2) )
1227 break;
1228 ptr1++; ptr2++;
1229 }
1230
1231 /* if no counterexample was found, <blist2> is a subset of <blist1> */
1232 return (i == 0) ? True : False;
1233 }
1234
1235
1236 /****************************************************************************
1237 **
1238 *F FuncUNITE_BLIST( <self>, <blist1>, <blist2> ) . unite one list with another
1239 **
1240 ** 'FuncUNITE_BLIST' implements the internal function 'UniteBlist'.
1241 **
1242 ** 'UniteBlist( <blist1>, <blist2> )'
1243 **
1244 ** 'UniteBlist' unites the boolean list <blist1> with the boolean list
1245 ** <blist2>, which must have the same length. This is equivalent to
1246 ** assigning '<blist1>[<i>] := <blist1>[<i>] or <blist2>[<i>]' for all <i>.
1247 */
FuncUNITE_BLIST(Obj self,Obj blist1,Obj blist2)1248 static Obj FuncUNITE_BLIST(Obj self, Obj blist1, Obj blist2)
1249 {
1250 UInt * ptr1; /* pointer to the first argument */
1251 const UInt * ptr2; /* pointer to the second argument */
1252 UInt i; /* loop variable */
1253
1254 RequireBlist("UniteBlist", blist1);
1255 RequireMutable("UniteBlist", blist1, "boolean list");
1256 RequireBlist("UniteBlist", blist2);
1257 RequireSameLength("UniteBlist", blist1, blist2);
1258
1259 /* compute the union by *or*-ing blockwise */
1260 ptr1 = BLOCKS_BLIST(blist1);
1261 ptr2 = CONST_BLOCKS_BLIST(blist2);
1262 for ( i = (LEN_BLIST(blist1)+BIPEB-1)/BIPEB; 0 < i; i-- ) {
1263 *ptr1++ |= *ptr2++;
1264 }
1265
1266 /* return nothing, this function is a procedure */
1267 return 0;
1268 }
1269
1270
1271 /****************************************************************************
1272 **
1273 *F FuncUNITE_BLIST_LIST( <self>, <list>,<blist>, <sub> )
1274 **
1275 ** 'FuncUNITE_BLIST_LIST' implements the internal function 'UniteBlistList'.
1276 **
1277 ** 'UniteBlistList( <list>,<blist>, <sub> )'
1278 **
1279 ** 'UniteBlistList' works like `BlistList', but adds the entries to the
1280 ** existing <blist>.
1281 */
FuncUNITE_BLIST_LIST(Obj self,Obj list,Obj blist,Obj sub)1282 static Obj FuncUNITE_BLIST_LIST(Obj self, Obj list, Obj blist, Obj sub)
1283 {
1284 UInt * ptrBlist; /* pointer to the boolean list */
1285 UInt block; /* one block of boolean list */
1286 UInt bit; /* one bit of block */
1287 Int lenList; /* logical length of the list */
1288 const Obj * ptrSub; /* pointer to the sublist */
1289 Int lenSub; /* logical length of sublist */
1290 Int i, j, k, l; /* loop variables */
1291 Int s, t; /* elements of a range */
1292
1293 RequireSmallList("UniteBlistList", list);
1294 RequireBlist("UniteBlistList", blist);
1295 RequireMutable("UniteBlistList", blist, "boolean list");
1296 RequireSameLength("UniteBlistList", blist, list);
1297 RequireSmallList("UniteBlistList", sub);
1298
1299 lenList = LEN_LIST( list );
1300 lenSub = LEN_LIST( sub );
1301
1302 // if the sublist is empty, nothing has to be done
1303 if (lenSub == 0) {
1304 return 0;
1305 }
1306
1307 /* for a range as subset of a range, it is extremely easy */
1308 if ( IS_RANGE(list) && IS_RANGE(sub) && GET_INC_RANGE( list ) == 1
1309 && GET_INC_RANGE( sub ) == 1) {
1310
1311 ptrBlist = BLOCKS_BLIST(blist);
1312
1313 /* get the bounds of the subset with respect to the boolean list */
1314 s = INT_INTOBJ( GET_ELM_RANGE( list, 1 ) );
1315 t = INT_INTOBJ( GET_ELM_RANGE( sub, 1 ) );
1316
1317 // compute bounds
1318 i = t - s;
1319 j = lenSub + i;
1320 if (i < 0)
1321 i = 0;
1322 if (j > lenList)
1323 j = lenList;
1324
1325 /* set the corresponding entries to 'true' */
1326 for ( k = i; k < j && k%BIPEB != 0; k++ )
1327 ptrBlist[k/BIPEB] |= (1UL << k%BIPEB);
1328 for ( ; k+BIPEB < j; k += BIPEB )
1329 ptrBlist[k/BIPEB] = ~(UInt)0;
1330 for ( ; k < j; k++ )
1331 ptrBlist[k/BIPEB] |= (1UL << k%BIPEB);
1332
1333 }
1334
1335 /* for a list as subset of a range, we need basically no search */
1336 else if ( IS_RANGE(list) && GET_INC_RANGE( list) == 1
1337 && IS_PLIST(sub) ) {
1338
1339 ptrBlist = BLOCKS_BLIST(blist);
1340 ptrSub = CONST_ADDR_OBJ(sub);
1341
1342 /* loop over <sub> and set the corresponding entries to 'true' */
1343 s = INT_INTOBJ( GET_ELM_RANGE( list, 1 ) );
1344 for ( l = 1; l <= LEN_LIST(sub); l++ ) {
1345 if ( ptrSub[l] != 0 ) {
1346
1347 /* if <sub>[<l>] is an integer it is very easy */
1348 if ( IS_INTOBJ( ptrSub[l] ) ) {
1349 t = INT_INTOBJ( ptrSub[l] ) - s + 1;
1350 if ( 0 < t && t <= lenList )
1351 ptrBlist[(t-1)/BIPEB] |= (1UL << (t-1)%BIPEB);
1352 }
1353 }
1354 }
1355
1356 }
1357
1358 /* if <list> is a set we have two possibilities */
1359 else if ( IsSet( list ) ) {
1360
1361 /* get the length of <list> and its logarithm */
1362 lenList = LEN_PLIST( list );
1363 for ( i = lenList, l = 0; i != 0; i >>= 1, l++ ) ;
1364 PLAIN_LIST( sub );
1365
1366 /* if <sub> is small, we loop over <sub> and use binary search */
1367 if ( l * lenSub < 2 * lenList ) {
1368
1369 /* allocate the boolean list and get pointer */
1370
1371 /* run over the elements of <sub> and search for the elements */
1372 for ( l = 1; l <= LEN_LIST(sub); l++ ) {
1373 if ( CONST_ADDR_OBJ(sub)[l] != 0 ) {
1374
1375 /* perform the binary search to find the position */
1376 i = 0; k = lenList+1;
1377 while ( i+1 < k ) {
1378 j = (i + k) / 2;
1379 if ( LT(CONST_ADDR_OBJ(list)[j],CONST_ADDR_OBJ(sub)[l]) )
1380 i = j;
1381 else
1382 k = j;
1383 }
1384
1385 /* set bit if <sub>[<l>] was found at position k */
1386 if ( k <= lenList
1387 && EQ( CONST_ADDR_OBJ(list)[k], CONST_ADDR_OBJ(sub)[l] ) )
1388 SET_BIT_BLIST(blist, k);
1389 }
1390 }
1391
1392 }
1393
1394 /* if <sub> is large, run over both list in parallel */
1395 else {
1396
1397 /* turn the <sub> into a set for faster searching */
1398 if ( ! IsSet( sub ) ) {
1399 sub = SetList( sub );
1400 lenSub = LEN_LIST( sub );
1401 }
1402
1403 /* run over the elements of <list> */
1404 k = 1;
1405 block = 0;
1406 bit = 1;
1407 for ( l = 1; l <= lenList; l++ ) {
1408
1409 /* test if <list>[<l>] is in <sub> */
1410 while ( k <= lenSub
1411 && LT(CONST_ADDR_OBJ(sub)[k],CONST_ADDR_OBJ(list)[l]) )
1412 k++;
1413
1414 /* if <list>[<k>] is in <sub> set the current bit in block */
1415 if ( k <= lenSub
1416 && EQ(CONST_ADDR_OBJ(sub)[k],CONST_ADDR_OBJ(list)[l]) ) {
1417 block |= bit;
1418 k++;
1419 }
1420
1421 /* if block is full add it to boolean list and start next */
1422 bit = bit << 1;
1423 if ( bit == 0 || l == lenList ) {
1424 *BLOCK_ELM_BLIST_PTR(blist, l) |= block;
1425 block = 0;
1426 bit = 1;
1427 }
1428
1429 }
1430 }
1431
1432 }
1433
1434 /* if <list> is not a set, we have to use brute force */
1435 else {
1436
1437 /* convert left argument to an ordinary list, ignore return value */
1438 PLAIN_LIST( list );
1439
1440 /* turn <sub> into a set for faster searching */
1441 if ( ! IsSet( sub ) ) sub = SetList( sub );
1442
1443 lenSub = LEN_PLIST( sub );
1444
1445 /* run over the elements of <list> */
1446 k = 1;
1447 block = 0;
1448 bit = 1;
1449 for ( l = 1; l <= lenList; l++ ) {
1450
1451 /* test if <list>[<l>] is in <sub> */
1452 if ( l == 1 || LT(CONST_ADDR_OBJ(list)[l-1],CONST_ADDR_OBJ(list)[l]) ){
1453 while ( k <= lenSub
1454 && LT(CONST_ADDR_OBJ(sub)[k],CONST_ADDR_OBJ(list)[l]) )
1455 k++;
1456 }
1457 else {
1458 i = 0; k = LEN_PLIST(sub) + 1;
1459 while ( i+1 < k ) {
1460 j = (i + k) / 2;
1461 if ( LT( CONST_ADDR_OBJ(sub)[j], CONST_ADDR_OBJ(list)[l] ) )
1462 i = j;
1463 else
1464 k = j;
1465 }
1466 }
1467
1468 /* if <list>[<k>] is in <sub> set the current bit in the block */
1469 if ( k <= lenSub
1470 && EQ( CONST_ADDR_OBJ(sub)[k], CONST_ADDR_OBJ(list)[l] ) ) {
1471 block |= bit;
1472 k++;
1473 }
1474
1475 /* if block is full add it to the boolean list and start next */
1476 bit = bit << 1;
1477 if ( bit == 0 || l == lenList ) {
1478 *BLOCK_ELM_BLIST_PTR(blist, l) |= block;
1479 block = 0;
1480 bit = 1;
1481 }
1482 }
1483
1484 }
1485
1486 /* return */
1487 return 0;
1488 }
1489
1490
1491 /****************************************************************************
1492 **
1493 *F FuncINTER_BLIST( <self>, <blist1>, <blist2> ) . <blist1> intersection <blist2>
1494 **
1495 ** 'FuncINTER_BLIST' implements the function 'IntersectBlist'.
1496 **
1497 ** 'IntersectBlist( <blist1>, <blist2> )'
1498 **
1499 ** 'IntersectBlist' intersects the boolean list <blist1> with the boolean
1500 ** list <blist2>, which must have the same length. This is equivalent to
1501 ** assigning '<blist1>[<i>] := <blist1>[<i>] and <blist2>[<i>]' for all <i>.
1502 */
FuncINTER_BLIST(Obj self,Obj blist1,Obj blist2)1503 static Obj FuncINTER_BLIST(Obj self, Obj blist1, Obj blist2)
1504 {
1505 UInt * ptr1; /* pointer to the first argument */
1506 const UInt * ptr2; /* pointer to the second argument */
1507 UInt i; /* loop variable */
1508
1509 RequireBlist("IntersectBlist", blist1);
1510 RequireMutable("IntersectBlist", blist1, "boolean list");
1511 RequireBlist("IntersectBlist", blist2);
1512 RequireSameLength("IntersectBlist", blist1, blist2);
1513
1514 /* compute the intersection by *and*-ing blockwise */
1515 ptr1 = BLOCKS_BLIST(blist1);
1516 ptr2 = CONST_BLOCKS_BLIST(blist2);
1517 for ( i = NUMBER_BLOCKS_BLIST(blist1); 0 < i; i-- )
1518 *ptr1++ &= *ptr2++;
1519
1520 /* return nothing, this function is a procedure */
1521 return 0;
1522 }
1523
1524
1525 /****************************************************************************
1526 **
1527 *F FuncSUBTR_BLIST( <self>, <blist1>, <blist2> ) . . . . . . <blist1> - <blist2>
1528 **
1529 ** 'FuncSUBTR_BLIST' implements the internal function 'SubtractBlist'.
1530 **
1531 ** 'SubtractBlist( <blist1>, <blist2> )'
1532 **
1533 ** 'SubtractBlist' subtracts the boolean list <blist2> from the boolean list
1534 ** <blist1>, which must have the same length. This is equivalent assigning
1535 ** '<blist1>[<i>] := <blist1>[<i>] and not <blist2>[<i>]' for all <i>.
1536 */
FuncSUBTR_BLIST(Obj self,Obj blist1,Obj blist2)1537 static Obj FuncSUBTR_BLIST(Obj self, Obj blist1, Obj blist2)
1538 {
1539 UInt * ptr1; /* pointer to the first argument */
1540 const UInt * ptr2; /* pointer to the second argument */
1541 UInt i; /* loop variable */
1542
1543 RequireBlist("SubtractBlist", blist1);
1544 RequireMutable("SubtractBlist", blist1, "boolean list");
1545 RequireBlist("SubtractBlist", blist2);
1546 RequireSameLength("SubtractBlist", blist1, blist2);
1547
1548 /* compute the difference by operating blockwise */
1549 ptr1 = BLOCKS_BLIST(blist1);
1550 ptr2 = CONST_BLOCKS_BLIST(blist2);
1551 for ( i = NUMBER_BLOCKS_BLIST(blist1); 0 < i; i-- )
1552 *ptr1++ &= ~ *ptr2++;
1553
1554 /* return nothing, this function is a procedure */
1555 return 0;
1556 }
1557
1558 /****************************************************************************
1559 **
1560 *F FuncMEET_BLIST( <self>, <blist1>, <blist2> ) . . .
1561 **
1562 ** 'FuncMEET_BLIST' implements the internal function 'MeetBlist'.
1563 **
1564 ** 'MeetBlist( <blist1>, <blist2> )'
1565 **
1566 ** 'MeetBlist' returns true if blist1 and blist2 have true in the same
1567 ** position and false otherwise. It is equivalent to, but faster than
1568 ** SizeBlist(IntersectionBlist(blist1, blist2)) <> 0
1569 ** The lists must have the same length.
1570 */
1571
FuncMEET_BLIST(Obj self,Obj blist1,Obj blist2)1572 static Obj FuncMEET_BLIST(Obj self, Obj blist1, Obj blist2)
1573 {
1574 const UInt * ptr1; /* pointer to the first argument */
1575 const UInt * ptr2; /* pointer to the second argument */
1576 UInt i; /* loop variable */
1577
1578 RequireBlist("MeetBlist", blist1);
1579 RequireBlist("MeetBlist", blist2);
1580 RequireSameLength("MeetBlist", blist1, blist2);
1581
1582 /* compute the difference by operating blockwise */
1583 ptr1 = CONST_BLOCKS_BLIST(blist1);
1584 ptr2 = CONST_BLOCKS_BLIST(blist2);
1585 for ( i = NUMBER_BLOCKS_BLIST(blist1); 0 < i; i-- )
1586 if (*ptr1++ & *ptr2++) return True;
1587
1588 return False;
1589 }
1590
1591 /****************************************************************************
1592 **
1593 *F FuncFLIP_BLIST( <self>, <blist> ) . . .
1594 **
1595 ** 'FuncFLIP_BLIST' implements the internal function 'FlipBlist'.
1596 **
1597 ** 'FlipBlist( <blist> )'
1598 **
1599 ** 'FlipBlist' changes every value in the blist <blist> from true to false,
1600 ** and vice versa.
1601 */
1602
FuncFLIP_BLIST(Obj self,Obj blist)1603 static Obj FuncFLIP_BLIST(Obj self, Obj blist)
1604 {
1605 // get and check the arguments
1606 RequireBlist("FlipBlist", blist);
1607 RequireMutable("FlipBlist", blist, "boolean list");
1608
1609 if (LEN_BLIST(blist) == 0) {
1610 return 0;
1611 }
1612
1613 UInt * ptr = BLOCKS_BLIST(blist);
1614 for (UInt i = NUMBER_BLOCKS_BLIST(blist); 0 < i; i--) {
1615 *ptr = ~(*ptr);
1616 ptr++;
1617 }
1618 // If the logical length of the boolean list is not a multiple of BIPEB the
1619 // last block will contain unused bits, which are then zero.
1620 UInt mask =
1621 ~(UInt)0 >> ((BIPEB * NUMBER_BLOCKS_BLIST(blist)) - LEN_BLIST(blist));
1622 ptr = BLOCK_ELM_BLIST_PTR(blist, LEN_BLIST(blist));
1623 *ptr &= mask;
1624 return 0;
1625 }
1626
1627 /****************************************************************************
1628 **
1629 *F FuncCLEAR_ALL_BLIST( <self>, <blist> ) . . .
1630 **
1631 ** 'FuncCLEAR_ALL_BLIST' implements the internal function 'ClearAllBlist'.
1632 **
1633 ** 'ClearAllBlist( <blist> )'
1634 **
1635 ** 'ClearAllBlist' changes every value in the blist <blist> to false.
1636 */
1637
FuncCLEAR_ALL_BLIST(Obj self,Obj blist)1638 static Obj FuncCLEAR_ALL_BLIST(Obj self, Obj blist)
1639 {
1640 // get and check the arguments
1641 RequireBlist("ClearAllBitsBlist", blist);
1642 RequireMutable("ClearAllBitsBlist", blist, "boolean list");
1643
1644 if (LEN_BLIST(blist) == 0) {
1645 return 0;
1646 }
1647
1648 UInt * ptr = BLOCKS_BLIST(blist);
1649 for (UInt i = NUMBER_BLOCKS_BLIST(blist); 0 < i; i--) {
1650 *ptr++ = 0;
1651 }
1652
1653 return 0;
1654 }
1655
1656 /****************************************************************************
1657 **
1658 *F FuncSET_ALL_BLIST( <self>, <blist> ) . . .
1659 **
1660 ** 'FuncSET_ALL_BLIST' implements the internal function 'SetAllBlist'.
1661 **
1662 ** 'SetAllBlist( <blist> )'
1663 **
1664 ** 'SetAllBlist' changes every value in the blist <blist> to true.
1665 */
1666
FuncSET_ALL_BLIST(Obj self,Obj blist)1667 static Obj FuncSET_ALL_BLIST(Obj self, Obj blist)
1668 {
1669 // get and check the arguments
1670 RequireBlist("SetAllBitsBlist", blist);
1671 RequireMutable("SetAllBitsBlist", blist, "boolean list");
1672
1673 if (LEN_BLIST(blist) == 0) {
1674 return 0;
1675 }
1676
1677 UInt * ptr = BLOCKS_BLIST(blist);
1678 for (UInt i = NUMBER_BLOCKS_BLIST(blist); 0 < i; i--) {
1679 *ptr++ = ~(UInt)0;
1680 }
1681 // If the logical length of the boolean list is not a multiple of BIPEB the
1682 // last block will contain unused bits, which are then zero.
1683 UInt mask =
1684 ~(UInt)0 >> ((BIPEB * NUMBER_BLOCKS_BLIST(blist)) - LEN_BLIST(blist));
1685 ptr = BLOCK_ELM_BLIST_PTR(blist, LEN_BLIST(blist));
1686 *ptr &= mask;
1687
1688 return 0;
1689 }
1690
1691 /****************************************************************************
1692 **
1693 **
1694 *F MakeImmutableBlist( <blist> )
1695 */
1696
MakeImmutableBlist(Obj blist)1697 static void MakeImmutableBlist(Obj blist)
1698 {
1699 MakeImmutableNoRecurse(blist);
1700 }
1701
1702 /****************************************************************************
1703 **
1704 **
1705 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
1706 */
1707
1708
1709 /****************************************************************************
1710 **
1711 *V BagNames . . . . . . . . . . . . . . . . . . . . . . . list of bag names
1712 */
1713 static StructBagNames BagNames[] = {
1714 { T_BLIST, "list (boolean)" },
1715 { T_BLIST +IMMUTABLE, "list (boolean,imm)" },
1716 { T_BLIST_NSORT, "list (boolean,nsort)" },
1717 { T_BLIST_NSORT +IMMUTABLE, "list (boolean,nsort,imm)" },
1718 { T_BLIST_SSORT, "list (boolean,ssort)" },
1719 { T_BLIST_SSORT +IMMUTABLE, "list (boolean,ssort,imm)" },
1720 { -1, "" }
1721 };
1722
1723
1724 /****************************************************************************
1725 **
1726 *V ClearFiltsTab . . . . . . . . . . . . . . . . . . . . clear filter tnums
1727 */
1728 static Int ClearFiltsTab [] = {
1729 T_BLIST, T_BLIST,
1730 T_BLIST_NSORT, T_BLIST,
1731 T_BLIST_SSORT, T_BLIST,
1732 -1, -1
1733 };
1734
1735
1736 /****************************************************************************
1737 **
1738 *V HasFiltTab . . . . . . . . . . . . . . . . . . . . . tester filter tnum
1739 */
1740 static Int HasFiltTab [] = {
1741
1742 /* mutable boolean list */
1743 T_BLIST, FN_IS_DENSE, 1,
1744 T_BLIST, FN_IS_NDENSE, 0,
1745 T_BLIST, FN_IS_HOMOG, 1,
1746 T_BLIST, FN_IS_NHOMOG, 0,
1747 T_BLIST, FN_IS_TABLE, 0,
1748 T_BLIST, FN_IS_SSORT, 0,
1749 T_BLIST, FN_IS_NSORT, 0,
1750
1751 /* nsort mutable boolean list */
1752 T_BLIST_NSORT, FN_IS_DENSE, 1,
1753 T_BLIST_NSORT, FN_IS_NDENSE, 0,
1754 T_BLIST_NSORT, FN_IS_HOMOG, 1,
1755 T_BLIST_NSORT, FN_IS_NHOMOG, 0,
1756 T_BLIST_NSORT, FN_IS_TABLE, 0,
1757 T_BLIST_NSORT, FN_IS_SSORT, 0,
1758 T_BLIST_NSORT, FN_IS_NSORT, 1,
1759
1760 /* ssort mutable boolean list */
1761 T_BLIST_SSORT, FN_IS_DENSE, 1,
1762 T_BLIST_SSORT, FN_IS_NDENSE, 0,
1763 T_BLIST_SSORT, FN_IS_HOMOG, 1,
1764 T_BLIST_SSORT, FN_IS_NHOMOG, 0,
1765 T_BLIST_SSORT, FN_IS_TABLE, 0,
1766 T_BLIST_SSORT, FN_IS_SSORT, 1,
1767 T_BLIST_SSORT, FN_IS_NSORT, 0,
1768
1769 -1, -1, -1
1770 };
1771
1772
1773 /****************************************************************************
1774 **
1775 *V SetFiltTab . . . . . . . . . . . . . . . . . . . . . setter filter tnum
1776 */
1777 static Int SetFiltTab [] = {
1778
1779 /* mutable boolean list */
1780 T_BLIST, FN_IS_DENSE, T_BLIST,
1781 T_BLIST, FN_IS_NDENSE, -1,
1782 T_BLIST, FN_IS_HOMOG, T_BLIST,
1783 T_BLIST, FN_IS_NHOMOG, -1,
1784 T_BLIST, FN_IS_TABLE, -1,
1785 T_BLIST, FN_IS_SSORT, T_BLIST_SSORT,
1786 T_BLIST, FN_IS_NSORT, T_BLIST_NSORT,
1787
1788 /* nsort mutable boolean list */
1789 T_BLIST_NSORT, FN_IS_DENSE, T_BLIST_NSORT,
1790 T_BLIST_NSORT, FN_IS_NDENSE, -1,
1791 T_BLIST_NSORT, FN_IS_HOMOG, T_BLIST_NSORT,
1792 T_BLIST_NSORT, FN_IS_NHOMOG, -1,
1793 T_BLIST_NSORT, FN_IS_TABLE, -1,
1794 T_BLIST_NSORT, FN_IS_SSORT, -1,
1795 T_BLIST_NSORT, FN_IS_NSORT, T_BLIST_NSORT,
1796
1797 /* ssort mutable boolean list */
1798 T_BLIST_SSORT, FN_IS_DENSE, T_BLIST_SSORT,
1799 T_BLIST_SSORT, FN_IS_NDENSE, -1,
1800 T_BLIST_SSORT, FN_IS_HOMOG, T_BLIST_SSORT,
1801 T_BLIST_SSORT, FN_IS_NHOMOG, -1,
1802 T_BLIST_SSORT, FN_IS_TABLE, -1,
1803 T_BLIST_SSORT, FN_IS_SSORT, T_BLIST_SSORT,
1804 T_BLIST_SSORT, FN_IS_NSORT, -1,
1805
1806 -1, -1, -1
1807
1808 };
1809
1810
1811 /****************************************************************************
1812 **
1813 *V ResetFiltTab . . . . . . . . . . . . . . . . . . . unsetter filter tnum
1814 */
1815 static Int ResetFiltTab [] = {
1816
1817 /* mutable boolean list */
1818 T_BLIST, FN_IS_DENSE, T_BLIST,
1819 T_BLIST, FN_IS_NDENSE, T_BLIST,
1820 T_BLIST, FN_IS_HOMOG, T_BLIST,
1821 T_BLIST, FN_IS_NHOMOG, T_BLIST,
1822 T_BLIST, FN_IS_TABLE, T_BLIST,
1823 T_BLIST, FN_IS_SSORT, T_BLIST,
1824 T_BLIST, FN_IS_NSORT, T_BLIST,
1825
1826 /* nsort mutable boolean list */
1827 T_BLIST_NSORT, FN_IS_DENSE, T_BLIST_NSORT,
1828 T_BLIST_NSORT, FN_IS_NDENSE, T_BLIST_NSORT,
1829 T_BLIST_NSORT, FN_IS_HOMOG, T_BLIST_NSORT,
1830 T_BLIST_NSORT, FN_IS_NHOMOG, T_BLIST_NSORT,
1831 T_BLIST_NSORT, FN_IS_TABLE, T_BLIST_NSORT,
1832 T_BLIST_NSORT, FN_IS_SSORT, T_BLIST_NSORT,
1833 T_BLIST_NSORT, FN_IS_NSORT, T_BLIST,
1834
1835 /* ssort mutable boolean list */
1836 T_BLIST_SSORT, FN_IS_DENSE, T_BLIST_SSORT,
1837 T_BLIST_SSORT, FN_IS_NDENSE, T_BLIST_SSORT,
1838 T_BLIST_SSORT, FN_IS_HOMOG, T_BLIST_SSORT,
1839 T_BLIST_SSORT, FN_IS_NHOMOG, T_BLIST_SSORT,
1840 T_BLIST_SSORT, FN_IS_TABLE, T_BLIST_SSORT,
1841 T_BLIST_SSORT, FN_IS_SSORT, T_BLIST,
1842 T_BLIST_SSORT, FN_IS_NSORT, T_BLIST_SSORT,
1843
1844 -1, -1, -1
1845
1846 };
1847
1848
1849 /****************************************************************************
1850 **
1851 *V GVarFilts . . . . . . . . . . . . . . . . . . . list of filters to export
1852 */
1853 static StructGVarFilt GVarFilts [] = {
1854
1855 GVAR_FILT(IS_BLIST, "obj", &IsBlistFilt),
1856 GVAR_FILT(IS_BLIST_REP, "obj", &IsBlistRepFilt),
1857 { 0, 0, 0, 0, 0 }
1858
1859 };
1860
1861
1862 /****************************************************************************
1863 **
1864 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1865 */
1866 static StructGVarFunc GVarFuncs [] = {
1867
1868 GVAR_FUNC(IS_BLIST_CONV, 1, "obj"),
1869 GVAR_FUNC(BLIST_LIST, 2, "list, sub"),
1870 GVAR_FUNC(LIST_BLIST, 2, "list, blist"),
1871 GVAR_FUNC(SIZE_BLIST, 1, "blist"),
1872 GVAR_FUNC(IS_SUB_BLIST, 2, "blist1, blist2"),
1873 GVAR_FUNC(UNITE_BLIST, 2, "blist1, blist2"),
1874 GVAR_FUNC(UNITE_BLIST_LIST, 3, "list, blist, sub"),
1875 GVAR_FUNC(INTER_BLIST, 2, "blist1, blist2"),
1876 GVAR_FUNC(SUBTR_BLIST, 2, "blist1, blist2"),
1877 GVAR_FUNC(MEET_BLIST, 2, "blist1, blist2"),
1878 GVAR_FUNC(FLIP_BLIST, 1, "blist"),
1879 GVAR_FUNC(CLEAR_ALL_BLIST, 1, "blist"),
1880 GVAR_FUNC(SET_ALL_BLIST, 1, "blist"),
1881 GVAR_FUNC(PositionNthTrueBlist, 2, "blist, nth"),
1882 { 0, 0, 0, 0, 0 }
1883
1884 };
1885
1886
1887 /****************************************************************************
1888 **
1889 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1890 */
InitKernel(StructInitInfo * module)1891 static Int InitKernel (
1892 StructInitInfo * module )
1893 {
1894 UInt t1;
1895 UInt t2;
1896
1897 /* init filters and functions */
1898 InitHdlrFiltsFromTable( GVarFilts );
1899 InitHdlrFuncsFromTable( GVarFuncs );
1900
1901 /* GASMAN marking functions and GASMAN names */
1902 InitBagNamesFromTable( BagNames );
1903
1904 for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
1905 InitMarkFuncBags( t1 , MarkNoSubBags );
1906 InitMarkFuncBags( t1 +IMMUTABLE , MarkNoSubBags );
1907 }
1908
1909 /* Make immutable blists public */
1910 #ifdef HPCGAP
1911 for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
1912 MakeBagTypePublic( t1 + IMMUTABLE );
1913 }
1914 #endif
1915
1916 /* install the type methods */
1917 TypeObjFuncs[ T_BLIST ] = TypeBlist;
1918 TypeObjFuncs[ T_BLIST +IMMUTABLE ] = TypeBlist;
1919 TypeObjFuncs[ T_BLIST_NSORT ] = TypeBlistNSort;
1920 TypeObjFuncs[ T_BLIST_NSORT +IMMUTABLE ] = TypeBlistNSort;
1921 TypeObjFuncs[ T_BLIST_SSORT ] = TypeBlistSSort;
1922 TypeObjFuncs[ T_BLIST_SSORT +IMMUTABLE ] = TypeBlistSSort;
1923
1924 /* initialise list tables */
1925 InitClearFiltsTNumsFromTable ( ClearFiltsTab );
1926 InitHasFiltListTNumsFromTable ( HasFiltTab );
1927 InitSetFiltListTNumsFromTable ( SetFiltTab );
1928 InitResetFiltListTNumsFromTable( ResetFiltTab );
1929
1930 /* Install the saving functions -- cannot save while copying */
1931 for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
1932 SaveObjFuncs[ t1 ] = SaveBlist;
1933 SaveObjFuncs[ t1 +IMMUTABLE ] = SaveBlist;
1934 LoadObjFuncs[ t1 ] = LoadBlist;
1935 LoadObjFuncs[ t1 +IMMUTABLE ] = LoadBlist;
1936 }
1937
1938 /* install the copy functions */
1939 for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
1940 #if !defined(USE_THREADSAFE_COPYING)
1941 CopyObjFuncs [ t1 ] = CopyBlist;
1942 CopyObjFuncs [ t1 +IMMUTABLE ] = CopyBlist;
1943 CleanObjFuncs[ t1 ] = 0;
1944 CleanObjFuncs[ t1 +IMMUTABLE ] = 0;
1945 #endif
1946 ShallowCopyObjFuncs[ t1 ] = ShallowCopyBlist;
1947 ShallowCopyObjFuncs[ t1 +IMMUTABLE ] = ShallowCopyBlist;
1948 }
1949
1950 /* install the comparison methods */
1951 for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT+IMMUTABLE; t1++ ) {
1952 for ( t2 = T_BLIST; t2 <= T_BLIST_SSORT+IMMUTABLE; t2++ ) {
1953 EqFuncs[ t1 ][ t2 ] = EqBlist;
1954 }
1955 }
1956
1957 /* install the list functions in the tables */
1958 for ( t1 = T_BLIST; t1 <= T_BLIST_SSORT; t1 += 2 ) {
1959 LenListFuncs [ t1 ] = LenBlist;
1960 LenListFuncs [ t1 +IMMUTABLE ] = LenBlist;
1961 IsbListFuncs [ t1 ] = IsbBlist;
1962 IsbListFuncs [ t1 +IMMUTABLE ] = IsbBlist;
1963 Elm0ListFuncs [ t1 ] = Elm0Blist;
1964 Elm0ListFuncs [ t1 +IMMUTABLE ] = Elm0Blist;
1965 Elm0vListFuncs [ t1 ] = Elm0vBlist;
1966 Elm0vListFuncs [ t1 +IMMUTABLE ] = Elm0vBlist;
1967 ElmListFuncs [ t1 ] = ElmBlist;
1968 ElmListFuncs [ t1 +IMMUTABLE ] = ElmBlist;
1969 ElmvListFuncs [ t1 ] = ElmvBlist;
1970 ElmvListFuncs [ t1 +IMMUTABLE ] = ElmvBlist;
1971 ElmwListFuncs [ t1 ] = ElmvBlist;
1972 ElmwListFuncs [ t1 +IMMUTABLE ] = ElmvBlist;
1973 ElmsListFuncs [ t1 ] = ElmsBlist;
1974 ElmsListFuncs [ t1 +IMMUTABLE ] = ElmsBlist;
1975 UnbListFuncs [ t1 ] = UnbBlist;
1976 AssListFuncs [ t1 ] = AssBlist;
1977 AsssListFuncs [ t1 ] = AsssListDefault;
1978 IsDenseListFuncs[ t1 ] = AlwaysYes;
1979 IsDenseListFuncs[ t1 +IMMUTABLE ] = AlwaysYes;
1980 IsHomogListFuncs[ t1 ] = IsHomogBlist;
1981 IsHomogListFuncs[ t1 +IMMUTABLE ] = IsHomogBlist;
1982 IsTableListFuncs[ t1 ] = AlwaysNo;
1983 IsTableListFuncs[ t1 +IMMUTABLE ] = AlwaysNo;
1984 IsPossListFuncs [ t1 ] = IsPossBlist;
1985 IsPossListFuncs [ t1 +IMMUTABLE ] = IsPossBlist;
1986 PosListFuncs [ t1 ] = PosBlist;
1987 PosListFuncs [ t1 +IMMUTABLE ] = PosBlist;
1988 PlainListFuncs [ t1 ] = PlainBlist;
1989 PlainListFuncs [ t1 +IMMUTABLE ] = PlainBlist;
1990 MakeImmutableObjFuncs [ t1 ] = MakeImmutableBlist;
1991 }
1992 IsSSortListFuncs[ T_BLIST ] = IsSSortBlist;
1993 IsSSortListFuncs[ T_BLIST +IMMUTABLE ] = IsSSortBlist;
1994 IsSSortListFuncs[ T_BLIST_NSORT ] = AlwaysNo;
1995 IsSSortListFuncs[ T_BLIST_NSORT +IMMUTABLE ] = AlwaysNo;
1996 IsSSortListFuncs[ T_BLIST_SSORT ] = AlwaysYes;
1997 IsSSortListFuncs[ T_BLIST_SSORT +IMMUTABLE ] = AlwaysYes;
1998
1999 /* Import the types of blists: */
2000 ImportGVarFromLibrary( "TYPE_BLIST_MUT", &TYPE_BLIST_MUT );
2001 ImportGVarFromLibrary( "TYPE_BLIST_IMM", &TYPE_BLIST_IMM );
2002 ImportGVarFromLibrary( "TYPE_BLIST_NSORT_MUT", &TYPE_BLIST_NSORT_MUT );
2003 ImportGVarFromLibrary( "TYPE_BLIST_NSORT_IMM", &TYPE_BLIST_NSORT_IMM );
2004 ImportGVarFromLibrary( "TYPE_BLIST_SSORT_MUT", &TYPE_BLIST_SSORT_MUT );
2005 ImportGVarFromLibrary( "TYPE_BLIST_SSORT_IMM", &TYPE_BLIST_SSORT_IMM );
2006 ImportGVarFromLibrary( "TYPE_BLIST_EMPTY_MUT", &TYPE_BLIST_EMPTY_MUT );
2007 ImportGVarFromLibrary( "TYPE_BLIST_EMPTY_IMM", &TYPE_BLIST_EMPTY_IMM );
2008
2009 /* return success */
2010 return 0;
2011 }
2012
2013
2014 /****************************************************************************
2015 **
2016 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
2017 */
InitLibrary(StructInitInfo * module)2018 static Int InitLibrary (
2019 StructInitInfo * module )
2020 {
2021 /* init filters and functions */
2022 InitGVarFiltsFromTable( GVarFilts );
2023 InitGVarFuncsFromTable( GVarFuncs );
2024
2025 /* return success */
2026 return 0;
2027 }
2028
2029
2030 /****************************************************************************
2031 **
2032 *F InitInfoBlist() . . . . . . . . . . . . . . . . . table of init functions
2033 */
2034 static StructInitInfo module = {
2035 // init struct using C99 designated initializers; for a full list of
2036 // fields, please refer to the definition of StructInitInfo
2037 .type = MODULE_BUILTIN,
2038 .name = "blister",
2039 .initKernel = InitKernel,
2040 .initLibrary = InitLibrary,
2041 };
2042
InitInfoBlist(void)2043 StructInitInfo * InitInfoBlist ( void )
2044 {
2045 return &module;
2046 }
2047