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 for generic lists.
11 */
12
13 #include "listfunc.h"
14
15 #include "ariths.h"
16 #include "blister.h"
17 #include "bool.h"
18 #include "calls.h"
19 #include "error.h"
20 #include "io.h"
21 #include "lists.h"
22 #include "modules.h"
23 #include "opers.h"
24 #include "permutat.h"
25 #include "plist.h"
26 #include "pperm.h"
27 #include "set.h"
28 #include "stringobj.h"
29 #include "sysfiles.h"
30 #include "trans.h"
31
32 #ifdef HPCGAP
33 #include "hpc/aobjects.h"
34 #endif
35
36 /****************************************************************************
37 **
38 *F AddList(<list>,<obj>) . . . . . . . . add an object to the end of a list
39 **
40 ** 'AddList' adds the object <obj> to the end of the list <list>, i.e.,
41 ** it is equivalent to the assignment '<list>[ Length(<list>)+1 ] := <obj>'.
42 ** The list is automatically extended to make room for the new element.
43 ** 'AddList' returns nothing, it is called only for its side effect.
44 */
AddList3(Obj list,Obj obj,Int pos)45 static void AddList3(Obj list, Obj obj, Int pos)
46 {
47 Int len;
48 Int i;
49 len = LEN_LIST(list);
50 if (pos == (Int) -1)
51 pos = len + 1;
52 for (i = len +1; i > pos; i--)
53 ASS_LIST(list, i, ELM_LIST(list, i-1));
54 ASS_LIST( list, pos, obj );
55 }
56
AddList(Obj list,Obj obj)57 void AddList (
58 Obj list,
59 Obj obj)
60 {
61 AddList3(list, obj, -1);
62 }
63
64
AddPlist3(Obj list,Obj obj,Int pos)65 static void AddPlist3(Obj list, Obj obj, Int pos)
66 {
67 UInt len;
68
69 if ( ! IS_PLIST_MUTABLE(list) ) {
70 ErrorMayQuit("List Assignment: <list> must be a mutable list", 0, 0);
71 }
72 /* in order to be optimistic when building list call assignment */
73 len = LEN_PLIST( list );
74 if (pos == (Int)-1)
75 pos = len + 1;
76 if ( len == 0) {
77 AssPlistEmpty( list, pos, obj );
78 return;
79 }
80 if (pos <= len) {
81 GROW_PLIST(list, len+1);
82 SET_LEN_PLIST(list, len+1);
83 Obj * ptr = ADDR_OBJ(list) + pos;
84 SyMemmove(ptr + 1, ptr, sizeof(Obj) * (len - pos + 1));
85 }
86 ASS_LIST(list, pos, obj);
87 }
88
AddPlist(Obj list,Obj obj)89 void AddPlist (
90 Obj list,
91 Obj obj)
92 {
93
94 AddPlist3(list, obj, -1);
95 }
96
97 static Obj AddListOper;
98
FuncADD_LIST3(Obj self,Obj list,Obj obj,Obj pos)99 static Obj FuncADD_LIST3(Obj self, Obj list, Obj obj, Obj pos)
100 {
101 /* dispatch */
102 Int ipos;
103 if (pos == (Obj)0)
104 ipos = -1;
105 else if (IS_INTOBJ(pos) && INT_INTOBJ(pos) > 0)
106 ipos = INT_INTOBJ(pos);
107 else {
108 DoOperation3Args( self, list, obj, pos);
109 return (Obj) 0;
110 }
111 if ( IS_PLIST( list ) ) {
112 AddPlist3( list, obj, ipos );
113 } else if ( TNUM_OBJ( list ) < FIRST_EXTERNAL_TNUM ) {
114 AddList3( list, obj, ipos );
115 #ifdef HPCGAP
116 // Only support adding to end of atomic lists
117 } else if ( TNUM_OBJ(list) == T_ALIST && pos == (Obj)0 ) {
118 AddAList( list, obj );
119 #endif
120 } else {
121 if (pos == 0)
122 DoOperation2Args( self, list, obj );
123 else
124 DoOperation3Args( self, list, obj, pos);
125 }
126
127 /* return nothing */
128 return (Obj)0;
129 }
130
131
FuncADD_LIST(Obj self,Obj list,Obj obj)132 static Obj FuncADD_LIST(Obj self, Obj list, Obj obj)
133 {
134 FuncADD_LIST3(self, list, obj, (Obj)0);
135 return (Obj) 0;
136 }
137
138
139 /****************************************************************************
140 **
141 *F RemList(<list>) . . . . . . . . remove an object from the end of a list
142 **
143 ** 'RemList' removes the last object <obj> from the end of the list <list>,
144 ** and returns it.
145 */
RemList(Obj list)146 static Obj RemList(Obj list)
147 {
148 Int pos;
149 Obj result;
150 pos = LEN_LIST( list ) ;
151 if ( pos == 0L ) {
152 ErrorMayQuit("Remove: <list> must not be empty", 0, 0);
153 }
154 result = ELM_LIST(list, pos);
155 UNB_LIST(list, pos);
156 return result;
157 }
158
RemPlist(Obj list)159 static Obj RemPlist(Obj list)
160 {
161 Int pos;
162 Obj removed;
163
164 if ( ! IS_PLIST_MUTABLE(list) ) {
165 ErrorMayQuit("Remove: <list> must be a mutable list", 0, 0);
166 }
167 pos = LEN_PLIST( list );
168 if ( pos == 0L ) {
169 ErrorMayQuit("Remove: <list> must not be empty", 0, 0);
170 }
171 removed = ELM_PLIST(list, pos);
172 SET_ELM_PLIST(list, pos, (Obj)0L);
173 pos--;
174 while ( 1 <= pos && ELM_PLIST( list, pos ) == 0 ) { pos--; }
175 SET_LEN_PLIST(list, pos);
176 if ( pos == 0 ) {
177 RetypeBag(list, T_PLIST_EMPTY);
178 }
179 if (4*pos*sizeof(Obj) < 3*SIZE_BAG(list))
180 SHRINK_PLIST(list, pos);
181 return removed;
182 }
183
184 static Obj RemListOper;
185
FuncREM_LIST(Obj self,Obj list)186 static Obj FuncREM_LIST(Obj self, Obj list)
187
188 {
189 /* dispatch */
190 if ( IS_PLIST( list ) ) {
191 return RemPlist( list);
192 }
193 else if ( TNUM_OBJ( list ) < FIRST_EXTERNAL_TNUM ) {
194 return RemList( list);
195 }
196 else {
197 return DoOperation1Args( self, list);
198 }
199
200 }
201
202
203 /****************************************************************************
204 **
205 *F FuncAPPEND_LIST_INTR(<list1>,<list2>) . . . . . append elements to a list
206 **
207 ** 'FuncAPPEND_LIST_INTR' implements the function 'AppendList'.
208 **
209 ** 'AppendList(<list1>,<list2>)'
210 **
211 ** 'AppendList' adds (see "Add") the elements of the list <list2> to the end
212 ** of the list <list1>. It is allowed that <list2> contains empty positions,
213 ** in which case the corresponding positions will be left empty in <list1>.
214 ** 'AppendList' returns nothing, it is called only for its side effect.
215 */
FuncAPPEND_LIST_INTR(Obj self,Obj list1,Obj list2)216 static Obj FuncAPPEND_LIST_INTR(Obj self, Obj list1, Obj list2)
217 {
218 UInt len1; /* length of the first list */
219 UInt len2; /* length of the second list */
220 Obj elm; /* one element of the second list */
221 Int i; /* loop variable */
222
223 /* check the mutability of the first argument */
224 RequireMutable("Append", list1, "list");
225
226
227 /* handle the case of strings now */
228 if (IS_STRING_REP(list1) && IS_STRING_REP(list2)) {
229 len1 = GET_LEN_STRING(list1);
230 len2 = GET_LEN_STRING(list2);
231 GROW_STRING(list1, len1 + len2);
232 SET_LEN_STRING(list1, len1 + len2);
233 CLEAR_FILTS_LIST(list1);
234 // copy data, including terminating zero byte
235 // Can't use memcpy, in case list1 == list2
236 SyMemmove(CHARS_STRING(list1) + len1, CONST_CHARS_STRING(list2), len2 + 1);
237 return (Obj) 0;
238 }
239
240 /* check the type of the first argument */
241 if ( TNUM_OBJ( list1 ) != T_PLIST ) {
242 RequireSmallList("AppendList", list1);
243 if ( ! IS_PLIST( list1 ) ) {
244 PLAIN_LIST( list1 );
245 }
246 RetypeBag( list1, T_PLIST );
247 }
248 len1 = LEN_PLIST( list1 );
249
250 /* check the type of the second argument */
251 if ( ! IS_PLIST( list2 ) ) {
252 RequireSmallList("AppendList", list2);
253 len2 = LEN_LIST( list2 );
254 }
255 else {
256 len2 = LEN_PLIST( list2 );
257 }
258
259 /* if the list has no room at the end, enlarge it */
260 if ( 0 < len2 ) {
261 GROW_PLIST( list1, len1+len2 );
262 SET_LEN_PLIST( list1, len1+len2 );
263 }
264
265 /* add the elements */
266 if ( IS_PLIST(list2) ) {
267 // note that the two memory regions can never overlap, even
268 // if list1 and list2 are identical
269 memcpy(ADDR_OBJ(list1) + 1 + len1, CONST_ADDR_OBJ(list2) + 1,
270 len2 * sizeof(Obj));
271 CHANGED_BAG( list1 );
272 }
273 else {
274 for ( i = 1; i <= len2; i++ ) {
275 elm = ELMV0_LIST( list2, i );
276 SET_ELM_PLIST( list1, i+len1, elm );
277 CHANGED_BAG( list1 );
278 }
279 }
280
281 /* return void */
282 return (Obj)0;
283 }
284
285 static Obj AppendListOper;
286
FuncAPPEND_LIST(Obj self,Obj list,Obj obj)287 static Obj FuncAPPEND_LIST(Obj self, Obj list, Obj obj)
288 {
289 /* dispatch */
290 if ( TNUM_OBJ( list ) < FIRST_EXTERNAL_TNUM ) {
291 FuncAPPEND_LIST_INTR( 0, list, obj );
292 }
293 else {
294 DoOperation2Args( self, list, obj );
295 }
296
297 /* return nothing */
298 return (Obj)0;
299 }
300
301
302 /****************************************************************************
303 **
304 *F POSITION_SORTED_LIST(<list>,<obj>) . . . . find an object in a sorted list
305 *F PositionSortedDensePlist(<list>,<obj>) . find an object in a sorted list
306 **
307 ** 'POSITION_SORTED_LIST' returns the position of the object <obj>, which may
308 ** be an object of any type, with respect to the sorted list <list>.
309 **
310 ** 'POSITION_SORTED_LIST' returns <pos> such that '<list>[<pos>-1] < <obj>'
311 ** and '<obj> <= <list>[<pos>]'. That means if <obj> appears once in <list>
312 ** its position is returned. If <obj> appears several times in <list>, the
313 ** position of the first occurrence is returned. If <obj> is not an element
314 ** of <list>, the index where <obj> must be inserted to keep the list sorted
315 ** is returned.
316 */
POSITION_SORTED_LIST(Obj list,Obj obj)317 static UInt POSITION_SORTED_LIST(Obj list, Obj obj)
318 {
319 UInt l; /* low */
320 UInt h; /* high */
321 UInt m; /* mid */
322 Obj v; /* one element of the list */
323
324 /* perform the binary search to find the position */
325 l = 0; h = LEN_LIST( list ) + 1;
326 while ( l+1 < h ) { /* list[l] < obj && obj <= list[h] */
327 m = (l + h) / 2; /* l < m < h */
328 v = ELMV_LIST( list, m );
329 if ( LT( v, obj ) ) { l = m; }
330 else { h = m; }
331 }
332
333 /* return the position */
334 return h;
335 }
336
PositionSortedDensePlist(Obj list,Obj obj)337 UInt PositionSortedDensePlist (
338 Obj list,
339 Obj obj )
340 {
341 UInt l; /* low */
342 UInt h; /* high */
343 UInt m; /* mid */
344 Obj v; /* one element of the list */
345
346 /* perform the binary search to find the position */
347 l = 0; h = LEN_PLIST( list ) + 1;
348 while ( l+1 < h ) { /* list[l] < obj && obj <= list[h] */
349 m = (l + h) / 2; /* l < m < h */
350 v = ELM_PLIST( list, m );
351 if ( LT( v, obj ) ) { l = m; }
352 else { h = m; }
353 }
354
355 /* return the position */
356 return h;
357 }
358
FuncPOSITION_SORTED_LIST(Obj self,Obj list,Obj obj)359 static Obj FuncPOSITION_SORTED_LIST(Obj self, Obj list, Obj obj)
360 {
361 UInt h; /* position, result */
362
363 /* check the first argument */
364 RequireSmallList("POSITION_SORTED_LIST", list);
365 /* dispatch */
366 if ( IS_DENSE_PLIST(list) ) {
367 h = PositionSortedDensePlist( list, obj );
368 }
369 else {
370 h = POSITION_SORTED_LIST( list, obj );
371 }
372
373 /* return the result */
374 return INTOBJ_INT( h );
375 }
376
377
378 /****************************************************************************
379 **
380 *F POSITION_SORTED_LISTComp(<list>,<obj>,<func>) . . find an object in a list
381 *F PositionSortedDensePlistComp(<list>,<obj>,<func>)find an object in a list
382 **
383 ** 'POSITION_SORTED_LISTComp' returns the position of the object <obj>, which
384 ** may be an object of any type, with respect to the list <list>, which is
385 ** sorted with respect to the comparison function <func>.
386 **
387 ** 'POSITION_SORTED_LISTComp' returns <pos> such that '<list>[<pos>-1] < <obj>'
388 ** and '<obj> <= <list>[<pos>]'. That means if <obj> appears once in <list>
389 ** its position is returned. If <obj> appears several times in <list>, the
390 ** position of the first occurrence is returned. If <obj> is not an element
391 ** of <list>, the index where <obj> must be inserted to keep the list sorted
392 ** is returned.
393 */
POSITION_SORTED_LISTComp(Obj list,Obj obj,Obj func)394 static UInt POSITION_SORTED_LISTComp(Obj list, Obj obj, Obj func)
395 {
396 UInt l; /* low */
397 UInt h; /* high */
398 UInt m; /* mid */
399 Obj v; /* one element of the list */
400
401 /* perform the binary search to find the position */
402 l = 0; h = LEN_LIST( list ) + 1;
403 while ( l+1 < h ) { /* list[l] < obj && obj <= list[h] */
404 m = (l + h) / 2; /* l < m < h */
405 v = ELMV_LIST( list, m );
406 if ( CALL_2ARGS( func, v, obj ) == True ) { l = m; }
407 else { h = m; }
408 }
409
410 /* return the position */
411 return h;
412 }
413
PositionSortedDensePlistComp(Obj list,Obj obj,Obj func)414 static UInt PositionSortedDensePlistComp(Obj list, Obj obj, Obj func)
415 {
416 UInt l; /* low */
417 UInt h; /* high */
418 UInt m; /* mid */
419 Obj v; /* one element of the list */
420
421 /* perform the binary search to find the position */
422 l = 0; h = LEN_PLIST( list ) + 1;
423 while ( l+1 < h ) { /* list[l] < obj && obj <= list[h] */
424 m = (l + h) / 2; /* l < m < h */
425 v = ELM_PLIST( list, m );
426 if ( CALL_2ARGS( func, v, obj ) == True ) { l = m; }
427 else { h = m; }
428 }
429
430 /* return the position */
431 return h;
432 }
433
434 static Obj
FuncPOSITION_SORTED_LIST_COMP(Obj self,Obj list,Obj obj,Obj func)435 FuncPOSITION_SORTED_LIST_COMP(Obj self, Obj list, Obj obj, Obj func)
436 {
437 UInt h; /* position, result */
438
439 /* check the first argument */
440 RequireSmallList("POSITION_SORTED_LIST_COMP", list);
441
442 /* check the third argument */
443 RequireFunction("POSITION_SORTED_LIST_COMP", func);
444
445 /* dispatch */
446 if ( IS_DENSE_PLIST(list) ) {
447 h = PositionSortedDensePlistComp( list, obj, func );
448 }
449 else {
450 h = POSITION_SORTED_LISTComp( list, obj, func );
451 }
452
453 /* return the result */
454 return INTOBJ_INT( h );
455 }
456
457
458 /****************************************************************************
459 **
460 ** Low-level implementations of PositionSortedBy for dense Plists and lists.
461 */
FuncPOSITION_SORTED_BY(Obj self,Obj list,Obj val,Obj func)462 static Obj FuncPOSITION_SORTED_BY(Obj self, Obj list, Obj val, Obj func)
463 {
464 RequirePlainList("POSITION_SORTED_BY", list);
465 RequireFunction("POSITION_SORTED_BY", func);
466
467 // perform the binary search to find the position
468 UInt l = 0;
469 UInt h = LEN_PLIST(list) + 1;
470 while (l + 1 < h) { // list[l] < val && val <= list[h]
471 UInt m = (l + h) / 2; // l < m < h
472 Obj v = CALL_1ARGS(func, ELM_PLIST(list, m));
473 if (LT(v, val)) {
474 l = m;
475 }
476 else {
477 h = m;
478 }
479 }
480
481 // return the result
482 return INTOBJ_INT(h);
483 }
484
485
486 /****************************************************************************
487 **
488 *F SORT_LIST( <list> ) . . . . . . . . . . . . . . . . . . . . sort a list
489 *F SortDensePlist( <list> ) . . . . . . . . . . . . . . . . . . sort a list
490 **
491 ** 'SORT_LIST' sorts the list <list> in increasing order.
492 */
493
494 // See sortbase.h for a description of these macros.
495
496 // We put these first, as they are the same for the next 4 functions so
497 // we do not have to repeat them
498 #define SORT_CREATE_TEMP_BUFFER(len) NEW_PLIST( T_PLIST, len + 1000);
499 #define SORT_ASS_BUF_TO_LOCAL(buffer, t, i) t = ELM_PLIST(buffer, i);
500 #define SORT_ASS_LOCAL_TO_BUF(buffer, i, j) \
501 SET_ELM_PLIST(buffer, i, j); \
502 CHANGED_BAG(buffer);
503
504
505 #define SORT_FUNC_NAME SORT_LIST
506 #define SORT_FUNC_ARGS Obj list
507 #define SORT_ARGS list
508 #define SORT_CREATE_LOCAL(name) Obj name ;
509 #define SORT_LEN_LIST() LEN_LIST(list)
510 #define SORT_ASS_LIST_TO_LOCAL(t, i) t = ELMV_LIST(list, i)
511 #define SORT_ASS_LOCAL_TO_LIST(i, j) ASS_LIST(list, i, j)
512 #define SORT_COMP(v, w) LT(v, w)
513 #define SORT_FILTER_CHECKS() \
514 if(IS_PLIST(list)) \
515 RESET_FILT_LIST(list, FN_IS_NSORT);
516
517 #include "sortbase.h"
518
519 #define SORT_FUNC_NAME SortDensePlist
520 #define SORT_FUNC_ARGS Obj list
521 #define SORT_ARGS list
522 #define SORT_CREATE_LOCAL(name) Obj name ;
523 #define SORT_LEN_LIST() LEN_PLIST(list)
524 #define SORT_ASS_LIST_TO_LOCAL(t, i) t = ELM_PLIST(list, i)
525 #define SORT_ASS_LOCAL_TO_LIST(i, j) \
526 SET_ELM_PLIST(list, i, j); \
527 CHANGED_BAG(list);
528 #define SORT_COMP(v, w) LT(v, w)
529 #define SORT_FILTER_CHECKS() \
530 RESET_FILT_LIST(list, FN_IS_NSORT);
531
532 #include "sortbase.h"
533
534 // This is a variant of SortDensePlist, which sorts plists by
535 // Obj pointer. It works on non-dense plists, and can be
536 // used to efficiently sort lists of small integers.
537
538 #define SORT_FUNC_NAME SortPlistByRawObj
539 #define SORT_FUNC_ARGS Obj list
540 #define SORT_ARGS list
541 #define SORT_CREATE_LOCAL(name) Obj name;
542 #define SORT_LEN_LIST() LEN_PLIST(list)
543 #define SORT_ASS_LIST_TO_LOCAL(t, i) t = ELM_PLIST(list, i)
544 #define SORT_ASS_LOCAL_TO_LIST(i, j) SET_ELM_PLIST(list, i, j);
545 #define SORT_COMP(v, w) ((v) < (w))
546 #define SORT_FILTER_CHECKS() \
547 RESET_FILT_LIST(list, FN_IS_NSORT); \
548 RESET_FILT_LIST(list, FN_IS_SSORT);
549
550 #include "sortbase.h"
551
552 /****************************************************************************
553 **
554 *F SORT_LISTComp(<list>,<func>) . . . . . . . . . . . . . . . . sort a list
555 *F SortDensePlistComp(<list>,<func>) . . . . . . . . . . . . . . sort a list
556 **
557 ** 'SORT_LISTComp' sorts the list <list> in increasing order, with respect to
558 ** comparison function <func>.
559 */
560 #define SORT_FUNC_NAME SORT_LISTComp
561 #define SORT_FUNC_ARGS Obj list, Obj func
562 #define SORT_ARGS list, func
563 #define SORT_CREATE_LOCAL(name) Obj name ;
564 #define SORT_LEN_LIST() LEN_LIST(list)
565 #define SORT_ASS_LIST_TO_LOCAL(t, i) t = ELMV_LIST(list, i)
566 #define SORT_ASS_LOCAL_TO_LIST(i, j) ASS_LIST(list, i, j)
567 #define SORT_COMP(v, w) CALL_2ARGS(func, v, w) == True
568 /* list is not necc. sorted wrt. \< (any longer) */
569 #define SORT_FILTER_CHECKS() \
570 RESET_FILT_LIST(list, FN_IS_SSORT); \
571 RESET_FILT_LIST(list, FN_IS_NSORT);
572
573 #include "sortbase.h"
574
575 #define SORT_FUNC_NAME SortDensePlistComp
576 #define SORT_FUNC_ARGS Obj list, Obj func
577 #define SORT_ARGS list, func
578 #define SORT_CREATE_LOCAL(name) Obj name ;
579 #define SORT_LEN_LIST() LEN_PLIST(list)
580 #define SORT_ASS_LIST_TO_LOCAL(t, i) t = ELM_PLIST(list, i)
581 #define SORT_ASS_LOCAL_TO_LIST(i, j) \
582 SET_ELM_PLIST(list, i, j); \
583 CHANGED_BAG(list);
584 #define SORT_COMP(v, w) CALL_2ARGS(func, v, w) == True
585 /* list is not necc. sorted wrt. \< (any longer) */
586 #define SORT_FILTER_CHECKS() \
587 RESET_FILT_LIST(list, FN_IS_SSORT); \
588 RESET_FILT_LIST(list, FN_IS_NSORT);
589
590 #include "sortbase.h"
591
592 /****************************************************************************
593 **
594 *F SORT_PARA_LIST( <list> ) . . . . . . . . . . . sort a lists with shadow
595 *F SortParaDensePlistPara( <list> ) . . . . . . . sort a lists with shadow
596 *F SORT_PARA_LISTComp(<list>,<func>) . . . . . . . sort a lists with shadow
597 *F SortParaDensePlistComp(<list>,<func>) . . . . . sort a lists with shadow
598 **
599 ** The following suite of functions mirrors the sort functions above. They
600 ** sort the first list given and perform the same operations on the second
601 ** list, the shadow list. All functions assume that shadow list has (at
602 ** least) the length of the first list.
603 **
604 ** The code here is a duplication of the code above with the operations on
605 ** the second list added in.
606 */
607
608 // Through this section, code of the form (void)(varname); stops
609 // various compilers warning about unused variables.
610 // These 3 macros are the same for all 4 of the following functions.
611 #undef SORT_CREATE_TEMP_BUFFER
612 #undef SORT_ASS_BUF_TO_LOCAL
613 #undef SORT_ASS_LOCAL_TO_BUF
614
615 #define SORT_CREATE_TEMP_BUFFER(len) NEW_PLIST( T_PLIST, len * 2 + 1000);
616 #define SORT_ASS_BUF_TO_LOCAL(buffer, t, i) \
617 t = ELM_PLIST(buffer, 2*(i)); \
618 t##s = ELM_PLIST(buffer, 2*(i)-1); (void)(t##s)
619 #define SORT_ASS_LOCAL_TO_BUF(buffer, i, j) \
620 SET_ELM_PLIST(buffer, 2*(i), j); \
621 SET_ELM_PLIST(buffer, 2*(i)-1, j##s); \
622 CHANGED_BAG(buffer);
623
624
625
626 #define SORT_FUNC_NAME SORT_PARA_LIST
627 #define SORT_FUNC_ARGS Obj list, Obj shadow
628 #define SORT_ARGS list, shadow
629 #define SORT_CREATE_LOCAL(name) Obj name ; Obj name##s ; (void)(name##s) ;
630 #define SORT_LEN_LIST() LEN_LIST(list)
631 #define SORT_ASS_LIST_TO_LOCAL(t, i) \
632 t = ELMV_LIST(list, i); \
633 t##s = ELMV_LIST(shadow, i);
634 #define SORT_ASS_LOCAL_TO_LIST(i, t) \
635 ASS_LIST(list, i, t); \
636 ASS_LIST(shadow, i, t##s);
637 #define SORT_COMP(v, w) LT( v, w )
638 /* if list was ssorted, then it still will be,
639 but, we don't know anything else any more */
640 #define SORT_FILTER_CHECKS() \
641 RESET_FILT_LIST(list, FN_IS_NSORT); \
642 RESET_FILT_LIST(shadow, FN_IS_SSORT); \
643 RESET_FILT_LIST(shadow, FN_IS_NSORT);
644
645 #include "sortbase.h"
646
647 #define SORT_FUNC_NAME SortParaDensePlist
648 #define SORT_FUNC_ARGS Obj list, Obj shadow
649 #define SORT_ARGS list, shadow
650 #define SORT_CREATE_LOCAL(name) Obj name ; Obj name##s ; (void)(name##s) ;
651 #define SORT_LEN_LIST() LEN_PLIST(list)
652 #define SORT_ASS_LIST_TO_LOCAL(t, i) \
653 t = ELM_PLIST(list, i); \
654 t##s = ELM_PLIST(shadow, i);
655 #define SORT_ASS_LOCAL_TO_LIST(i, t) \
656 SET_ELM_PLIST(list, i, t); \
657 SET_ELM_PLIST(shadow, i, t##s); \
658 CHANGED_BAG(list); \
659 CHANGED_BAG(shadow);
660 #define SORT_COMP(v, w) LT( v, w )
661 /* if list was ssorted, then it still will be,
662 but, we don't know anything else any more */
663 #define SORT_FILTER_CHECKS() \
664 RESET_FILT_LIST(list, FN_IS_NSORT); \
665 RESET_FILT_LIST(shadow, FN_IS_SSORT); \
666 RESET_FILT_LIST(shadow, FN_IS_NSORT);
667
668 #include "sortbase.h"
669
670 #define SORT_FUNC_NAME SORT_PARA_LISTComp
671 #define SORT_FUNC_ARGS Obj list, Obj shadow, Obj func
672 #define SORT_ARGS list, shadow, func
673 #define SORT_CREATE_LOCAL(name) Obj name ; Obj name##s ; (void)(name##s) ;
674 #define SORT_LEN_LIST() LEN_LIST(list)
675 #define SORT_ASS_LIST_TO_LOCAL(t, i) \
676 t = ELMV_LIST(list, i); \
677 t##s = ELMV_LIST(shadow, i);
678 #define SORT_ASS_LOCAL_TO_LIST(i, t) \
679 ASS_LIST(list, i, t); \
680 ASS_LIST(shadow, i, t##s);
681 #define SORT_COMP(v, w) CALL_2ARGS( func, v, w ) == True
682 /* list is not necc. sorted wrt. \< (any longer) */
683 #define SORT_FILTER_CHECKS() \
684 RESET_FILT_LIST(list, FN_IS_SSORT); \
685 RESET_FILT_LIST(list, FN_IS_NSORT); \
686 RESET_FILT_LIST(shadow, FN_IS_NSORT); \
687 RESET_FILT_LIST(shadow, FN_IS_SSORT);
688
689 #include "sortbase.h"
690
691 #define SORT_FUNC_NAME SortParaDensePlistComp
692 #define SORT_FUNC_ARGS Obj list, Obj shadow, Obj func
693 #define SORT_ARGS list, shadow, func
694 #define SORT_CREATE_LOCAL(name) Obj name ; Obj name##s ; (void)(name##s) ;
695 #define SORT_LEN_LIST() LEN_PLIST(list)
696 #define SORT_ASS_LIST_TO_LOCAL(t, i) \
697 t = ELM_PLIST(list, i); \
698 t##s = ELM_PLIST(shadow, i);
699 #define SORT_ASS_LOCAL_TO_LIST(i, t) \
700 SET_ELM_PLIST(list, i, t); \
701 SET_ELM_PLIST(shadow, i, t##s); \
702 CHANGED_BAG(list); \
703 CHANGED_BAG(shadow);
704 #define SORT_COMP(v, w) CALL_2ARGS( func, v, w ) == True
705 /* list is not necc. sorted wrt. \< (any longer) */
706 #define SORT_FILTER_CHECKS() \
707 RESET_FILT_LIST(list, FN_IS_SSORT); \
708 RESET_FILT_LIST(list, FN_IS_NSORT); \
709 RESET_FILT_LIST(shadow, FN_IS_NSORT); \
710 RESET_FILT_LIST(shadow, FN_IS_SSORT);
711
712 #include "sortbase.h"
713
714
715
716 /****************************************************************************
717 **
718 *F RemoveDupsDensePlist(<list>) . . . . remove duplicates from a plain list
719 **
720 ** 'RemoveDupsDensePlist' removes duplicate elements from the dense
721 ** plain list <list>. <list> must be sorted. 'RemoveDupsDensePlist'
722 ** returns 0 if <list> contains mutable elements, 1 if not and 2 if
723 ** the list contains immutable elements all lying in the same family.
724 */
RemoveDupsDensePlist(Obj list)725 UInt RemoveDupsDensePlist (
726 Obj list )
727 {
728 UInt mutable; /* the elements are mutable */
729 UInt homog; /* the elements all lie in the same family */
730 Int len; /* length of the list */
731 Obj v, w; /* two elements of the list */
732 UInt l, i; /* loop variables */
733 Obj fam;
734
735 /* get the length, nothing to be done for empty lists */
736 len = LEN_PLIST( list );
737 if ( len == 0 ) { return 0; }
738
739 /* select the first element as the first representative */
740 l = 1;
741 v = ELM_PLIST( list, l );
742 mutable = IS_MUTABLE_OBJ(v);
743 homog = 1;
744 fam = FAMILY_OBJ(v);
745
746 /* loop over the other elements, compare them with the current rep. */
747 for ( i = 2; i <= len; i++ ) {
748 w = ELM_PLIST( list, i );
749 mutable = (mutable || IS_MUTABLE_OBJ(w));
750 if ( ! EQ( v, w ) ) {
751 if ( l+1 != i ) {
752 SET_ELM_PLIST( list, l+1, w );
753 SET_ELM_PLIST( list, i, (Obj)0 );
754 }
755 l += 1;
756 v = w;
757 homog = (!mutable && homog && fam == FAMILY_OBJ(w));
758 }
759 }
760
761 /* the list may be shorter now */
762 SET_LEN_PLIST( list, l );
763 SHRINK_PLIST( list, l );
764
765 /* Set appropriate filters */
766 if (!mutable)
767 {
768 if (!homog)
769 SET_FILT_LIST(list, FN_IS_NHOMOG);
770 else
771 SET_FILT_LIST(list, FN_IS_HOMOG);
772 SET_FILT_LIST(list, FN_IS_SSORT);
773 }
774
775 /* return whether the list contains mutable elements */
776 if (mutable)
777 return 0;
778 if (!homog)
779 return 1;
780 else
781 return 2;
782 }
783
784
785 /****************************************************************************
786 **
787 *F * * * * * * * * * * * * * * GAP level functions * * * * * * * * * * * * *
788 */
789
790 /****************************************************************************
791 **
792 *F FuncSORT_LIST( <self>, <list> ) . . . . . . . . . . . . . . . sort a list
793 */
FuncSORT_LIST(Obj self,Obj list)794 static Obj FuncSORT_LIST(Obj self, Obj list)
795 {
796 /* check the first argument */
797 RequireSmallList("SORT_LIST", list);
798
799 /* dispatch */
800 if ( IS_DENSE_PLIST(list) ) {
801 SortDensePlist( list );
802 }
803 else {
804 SORT_LIST( list );
805 }
806 IS_SSORT_LIST(list);
807
808 /* return nothing */
809 return (Obj)0;
810 }
811
FuncSTABLE_SORT_LIST(Obj self,Obj list)812 static Obj FuncSTABLE_SORT_LIST(Obj self, Obj list)
813 {
814 /* check the first argument */
815 RequireSmallList("STABLE_SORT_LIST", list);
816
817 /* dispatch */
818 if ( IS_DENSE_PLIST(list) ) {
819 SortDensePlistMerge( list );
820 }
821 else {
822 SORT_LISTMerge( list );
823 }
824 IS_SSORT_LIST(list);
825
826 /* return nothing */
827 return (Obj)0;
828 }
829
830
831
832 /****************************************************************************
833 **
834 *F FuncSORT_LIST_COMP( <self>, <list>, <func> ) . . . . . . . . sort a list
835 */
FuncSORT_LIST_COMP(Obj self,Obj list,Obj func)836 static Obj FuncSORT_LIST_COMP(Obj self, Obj list, Obj func)
837 {
838 /* check the first argument */
839 RequireSmallList("SORT_LIST_COMP", list);
840
841 /* check the third argument */
842 RequireFunction("SORT_LIST_COMP", func);
843
844 /* dispatch */
845 if ( IS_DENSE_PLIST(list) ) {
846 SortDensePlistComp( list, func );
847 }
848 else {
849 SORT_LISTComp( list, func );
850 }
851
852 /* return nothing */
853 return (Obj)0;
854 }
855
FuncSTABLE_SORT_LIST_COMP(Obj self,Obj list,Obj func)856 static Obj FuncSTABLE_SORT_LIST_COMP(Obj self, Obj list, Obj func)
857 {
858 /* check the first argument */
859 RequireSmallList("STABLE_SORT_LIST_COMP", list);
860
861 /* check the third argument */
862 RequireFunction("STABLE_SORT_LIST_COMP", func);
863
864 /* dispatch */
865 if ( IS_DENSE_PLIST(list) ) {
866 SortDensePlistCompMerge( list, func );
867 }
868 else {
869 SORT_LISTCompMerge( list, func );
870 }
871
872 /* return nothing */
873 return (Obj)0;
874 }
875
876
877 /****************************************************************************
878 **
879 *F FuncSORT_PARA_LIST( <self>, <list> ) . . . . . . sort a list with shadow
880 */
FuncSORT_PARA_LIST(Obj self,Obj list,Obj shadow)881 static Obj FuncSORT_PARA_LIST(Obj self, Obj list, Obj shadow)
882 {
883 /* check the first two arguments */
884 RequireSmallList("SORT_PARA_LIST", list);
885 RequireSmallList("SORT_PARA_LIST", shadow);
886 RequireSameLength("SORT_PARA_LIST", list, shadow);
887
888 /* dispatch */
889 if ( IS_DENSE_PLIST(list) && IS_DENSE_PLIST(shadow) ) {
890 SortParaDensePlist( list, shadow );
891 }
892 else {
893 SORT_PARA_LIST( list, shadow );
894 }
895 IS_SSORT_LIST(list);
896
897 /* return nothing */
898 return (Obj)0;
899 }
900
FuncSTABLE_SORT_PARA_LIST(Obj self,Obj list,Obj shadow)901 static Obj FuncSTABLE_SORT_PARA_LIST(Obj self, Obj list, Obj shadow)
902 {
903 /* check the first two arguments */
904 RequireSmallList("STABLE_SORT_PARA_LIST", list);
905 RequireSmallList("STABLE_SORT_PARA_LIST", shadow);
906 RequireSameLength("STABLE_SORT_PARA_LIST", list, shadow);
907
908 /* dispatch */
909 if ( IS_DENSE_PLIST(list) && IS_DENSE_PLIST(shadow) ) {
910 SortParaDensePlistMerge( list, shadow );
911 }
912 else {
913 SORT_PARA_LISTMerge( list, shadow );
914 }
915 IS_SSORT_LIST(list);
916
917 /* return nothing */
918 return (Obj)0;
919 }
920
921
922 /****************************************************************************
923 **
924 *F FuncSORT_LIST_COMP( <self>, <list>, <func> ) . . . . . . . . sort a list
925 */
FuncSORT_PARA_LIST_COMP(Obj self,Obj list,Obj shadow,Obj func)926 static Obj FuncSORT_PARA_LIST_COMP(Obj self, Obj list, Obj shadow, Obj func)
927 {
928 /* check the first two arguments */
929 RequireSmallList("SORT_PARA_LIST_COMP", list);
930 RequireSmallList("SORT_PARA_LIST_COMP", shadow);
931 RequireSameLength("SORT_PARA_LIST_COMP", list, shadow);
932
933 /* check the third argument */
934 RequireFunction("SORT_PARA_LIST_COMP", func);
935
936 /* dispatch */
937 if ( IS_DENSE_PLIST(list) && IS_DENSE_PLIST(shadow) ) {
938 SortParaDensePlistComp( list, shadow, func );
939 }
940 else {
941 SORT_PARA_LISTComp( list, shadow, func );
942 }
943
944 /* return nothing */
945 return (Obj)0;
946 }
947
948 static Obj
FuncSTABLE_SORT_PARA_LIST_COMP(Obj self,Obj list,Obj shadow,Obj func)949 FuncSTABLE_SORT_PARA_LIST_COMP(Obj self, Obj list, Obj shadow, Obj func)
950 {
951 /* check the first two arguments */
952 RequireSmallList("SORT_PARA_LIST_COMP", list);
953 RequireSmallList("SORT_PARA_LIST_COMP", shadow);
954 RequireSameLength("SORT_PARA_LIST_COMP", list, shadow);
955
956 /* check the third argument */
957 RequireFunction("SORT_PARA_LIST_COMP", func);
958
959 /* dispatch */
960 if ( IS_DENSE_PLIST(list) && IS_DENSE_PLIST(shadow) ) {
961 SortParaDensePlistCompMerge( list, shadow, func );
962 }
963 else {
964 SORT_PARA_LISTCompMerge( list, shadow, func );
965 }
966
967 /* return nothing */
968 return (Obj)0;
969 }
970
971
972 /****************************************************************************
973 **
974 *F FuncOnPoints( <self>, <point>, <elm> ) . . . . . . . operation on points
975 **
976 ** 'FuncOnPoints' implements the internal function 'OnPoints'.
977 **
978 ** 'OnPoints( <point>, <elm> )'
979 **
980 ** specifies the canonical default operation. Passing this function is
981 ** equivalent to specifying no operation. This function exists because
982 ** there are places where the operation in not an option.
983 */
FuncOnPoints(Obj self,Obj point,Obj elm)984 static Obj FuncOnPoints(Obj self, Obj point, Obj elm)
985 {
986 return POW( point, elm );
987 }
988
989
990 /****************************************************************************
991 **
992 *F FuncOnPairs( <self>, <pair>, <elm> ) . . . operation on pairs of points
993 **
994 ** 'FuncOnPairs' implements the internal function 'OnPairs'.
995 **
996 ** 'OnPairs( <pair>, <elm> )'
997 **
998 ** specifies the componentwise operation of group elements on pairs of
999 ** points, which are represented by lists of length 2.
1000 */
FuncOnPairs(Obj self,Obj pair,Obj elm)1001 static Obj FuncOnPairs(Obj self, Obj pair, Obj elm)
1002 {
1003 Obj img; /* image, result */
1004 Obj tmp; /* temporary */
1005
1006 /* check the type of the first argument */
1007 if (!IS_SMALL_LIST(pair) || LEN_LIST(pair) != 2) {
1008 ErrorMayQuit("OnPairs: <pair> must be a list of length 2 (not a %s)",
1009 (Int)TNAM_OBJ(pair), 0);
1010 }
1011
1012 /* create a new bag for the result */
1013 img = NEW_PLIST_WITH_MUTABILITY( IS_MUTABLE_OBJ(pair), T_PLIST, 2 );
1014 SET_LEN_PLIST( img, 2 );
1015
1016 /* and enter the images of the points into the result bag */
1017 tmp = POW( ELMV_LIST( pair, 1 ), elm );
1018 SET_ELM_PLIST( img, 1, tmp );
1019 CHANGED_BAG( img );
1020 tmp = POW( ELMV_LIST( pair, 2 ), elm );
1021 SET_ELM_PLIST( img, 2, tmp );
1022 CHANGED_BAG( img );
1023
1024 /* return the result */
1025 return img;
1026 }
1027
1028
1029 /****************************************************************************
1030 **
1031 *F FuncOnTuples( <self>, <tuple>, <elm> ) . . operation on tuples of points
1032 **
1033 ** 'FuncOnTuples' implements the internal function 'OnTuples'.
1034 **
1035 ** 'OnTuples( <tuple>, <elm> )'
1036 **
1037 ** specifies the componentwise operation of group elements on tuples of
1038 ** points, which are represented by lists. 'OnPairs' is the special case of
1039 ** 'OnTuples' for tuples with two elements.
1040 */
FuncOnTuples(Obj self,Obj tuple,Obj elm)1041 static Obj FuncOnTuples(Obj self, Obj tuple, Obj elm)
1042 {
1043 Obj img; /* image, result */
1044 Obj tmp; /* temporary */
1045 UInt i; /* loop variable */
1046
1047 /* check the type of the first argument */
1048 RequireSmallList("OnTuples", tuple);
1049
1050 /* special case for the empty list */
1051 if (LEN_LIST(tuple) == 0) {
1052 if (IS_MUTABLE_OBJ(tuple)) {
1053 img = NewEmptyPlist();
1054 return img;
1055 } else {
1056 return tuple;
1057 }
1058 }
1059 /* special case for permutations */
1060 if (IS_PERM(elm)) {
1061 PLAIN_LIST( tuple );
1062 return OnTuplesPerm( tuple, elm );
1063 }
1064
1065 /* special case for transformations */
1066 if (IS_TRANS(elm)) {
1067 PLAIN_LIST( tuple );
1068 return OnTuplesTrans( tuple, elm );
1069 }
1070
1071 /* special case for partial perms */
1072 if (IS_PPERM(elm)) {
1073 PLAIN_LIST( tuple );
1074 return OnTuplesPPerm( tuple, elm );
1075 }
1076
1077 /* create a new bag for the result */
1078 img = NEW_PLIST_WITH_MUTABILITY( IS_MUTABLE_OBJ(tuple), T_PLIST, LEN_LIST(tuple) );
1079 SET_LEN_PLIST( img, LEN_LIST(tuple) );
1080
1081 /* and enter the images of the points into the result bag */
1082 for ( i = LEN_LIST(tuple); 1 <= i; i-- ) {
1083 tmp = POW( ELMV_LIST( tuple, i ), elm );
1084 SET_ELM_PLIST( img, i, tmp );
1085 CHANGED_BAG( img );
1086 }
1087
1088 /* return the result (must be a dense plain list, see 'FuncOnSets') */
1089 return img;
1090 }
1091
1092
1093 /****************************************************************************
1094 **
1095 *F FuncOnSets( <self>, <tuple>, <elm> ) . . . . operation on sets of points
1096 **
1097 ** 'FuncOnSets' implements the internal function 'OnSets'.
1098 **
1099 ** 'OnSets( <tuple>, <elm> )'
1100 **
1101 ** specifies the operation of group elements on sets of points, which are
1102 ** represented by sorted lists of points without duplicates (see "Sets").
1103 */
1104
FuncOnSets(Obj self,Obj set,Obj elm)1105 static Obj FuncOnSets(Obj self, Obj set, Obj elm)
1106 {
1107 Obj img; /* handle of the image, result */
1108 UInt status; /* the elements are mutable */
1109
1110 /* check the type of the first argument */
1111 if (!HAS_FILT_LIST(set, FN_IS_SSORT) && !IsSet(set)) {
1112 RequireArgument("OnSets", set, "must be a set");
1113 }
1114
1115 /* special case for the empty list */
1116 if (LEN_LIST(set) == 0) {
1117 if (IS_MUTABLE_OBJ(set)) {
1118 img = NewEmptyPlist();
1119 return img;
1120 } else {
1121 return set;
1122 }
1123 }
1124
1125 /* special case for permutations */
1126 if (IS_PERM(elm)) {
1127 PLAIN_LIST( set );
1128 return OnSetsPerm( set, elm );
1129 }
1130
1131 /* special case for transformations */
1132 if (IS_TRANS(elm)){
1133 PLAIN_LIST(set);
1134 return OnSetsTrans( set, elm);
1135 }
1136
1137 /* special case for partial perms */
1138 if (IS_PPERM(elm)){
1139 PLAIN_LIST(set);
1140 return OnSetsPPerm( set, elm);
1141 }
1142
1143 /* compute the list of images */
1144 img = FuncOnTuples( self, set, elm );
1145
1146 /* sort the images list (which is a dense plain list) */
1147 SortDensePlist( img );
1148
1149 /* remove duplicates, check for mutable elements */
1150 status = RemoveDupsDensePlist( img );
1151
1152 /* if possible, turn this into a set */
1153 switch (status)
1154 {
1155 case 0:
1156 break;
1157
1158 case 1:
1159 RetypeBagSM( img, T_PLIST_DENSE_NHOM_SSORT );
1160
1161 case 2:
1162 RetypeBagSM( img, T_PLIST_HOM_SSORT );
1163
1164 }
1165
1166
1167 /* return set */
1168 return img;
1169 }
1170
1171
1172 /****************************************************************************
1173 **
1174 *F FuncOnRight( <self>, <point>, <elm> ) . operation by mult. from the right
1175 **
1176 ** 'FuncOnRight' implements the internal function 'OnRight'.
1177 **
1178 ** 'OnRight( <point>, <elm> )'
1179 **
1180 ** specifies that group elements operate by multiplication from the right.
1181 */
FuncOnRight(Obj self,Obj point,Obj elm)1182 static Obj FuncOnRight(Obj self, Obj point, Obj elm)
1183 {
1184 return PROD( point, elm );
1185 }
1186
1187
1188 /****************************************************************************
1189 **
1190 *F FuncOnLeftInverse( <self>, <point>, <elm> ) . . op by mult. from the left
1191 **
1192 ** 'FuncOnLeftInverse' implements the internal function 'OnLeftInverse'.
1193 **
1194 ** 'OnLeftInverse( <point>, <elm> )'
1195 **
1196 ** specifies that group elements operate by multiplication from the left
1197 ** with the inverse.
1198 */
FuncOnLeftInverse(Obj self,Obj point,Obj elm)1199 static Obj FuncOnLeftInverse(Obj self, Obj point, Obj elm)
1200 {
1201 return LQUO(elm, point);
1202 }
1203
1204 /****************************************************************************
1205 **
1206 *F FuncSTRONGLY_CONNECTED_COMPONENTS_DIGRAPH
1207 **
1208 ** `digraph' should be a list whose entries and the lists of out-neighbours
1209 ** of the vertices. So [[2,3],[1],[2]] represents the graph whose edges are
1210 ** 1->2, 1->3, 2->1 and 3->2.
1211 **
1212 ** returns a newly constructed list whose elements are lists representing the
1213 ** strongly connected components of the directed graph. Neither the components,
1214 ** nor their elements are in any particular order.
1215 **
1216 ** The algorithm is that of Tarjan, based on the implementation in Sedgwick,
1217 ** with a bug fixed, and made non-recursive to avoid problems with stack limits
1218 ** under (for instance) Linux. This version is a bit slower than the recursive
1219 ** version, but much faster than any of the GAP implementations.
1220 **
1221 ** A possible change is to allocate the internal arrays rather smaller, and
1222 ** grow them if needed. This might allow some computations to complete that would
1223 ** otherwise run out of memory, but would slow things down a bit.
1224 */
1225
1226
FuncSTRONGLY_CONNECTED_COMPONENTS_DIGRAPH(Obj self,Obj digraph)1227 static Obj FuncSTRONGLY_CONNECTED_COMPONENTS_DIGRAPH(Obj self, Obj digraph)
1228 {
1229 UInt i,level,k,l,x,t,m;
1230 UInt now = 0,n;
1231 Obj val, stack, comps,comp;
1232 Obj frames, adj;
1233 UInt *fptr;
1234
1235 n = LEN_LIST(digraph);
1236 if (n == 0)
1237 {
1238 return NewEmptyPlist();
1239 }
1240 val = NewBag(T_DATOBJ, (n+1)*sizeof(UInt));
1241 stack = NEW_PLIST(T_PLIST_CYC, n);
1242 comps = NEW_PLIST(T_PLIST_TAB, n);
1243 frames = NewBag(T_DATOBJ, (4*n+1)*sizeof(UInt));
1244 for (k = 1; k <= n; k++)
1245 {
1246 if (((const UInt *)CONST_ADDR_OBJ(val))[k] == 0)
1247 {
1248 level = 1;
1249 adj = ELM_LIST(digraph, k);
1250 PLAIN_LIST(adj);
1251 fptr = (UInt *)ADDR_OBJ(frames);
1252 fptr[0] = k;
1253 now++;
1254 ((UInt *)ADDR_OBJ(val))[k] = now;
1255 fptr[1] = now;
1256 l = LEN_PLIST(stack);
1257 SET_ELM_PLIST(stack, l+1, INTOBJ_INT(k));
1258 SET_LEN_PLIST(stack, l+1);
1259 fptr[2] = 1;
1260 fptr[3] = (UInt)adj;
1261 while (level > 0 ) {
1262 if (fptr[2] > LEN_PLIST((Obj)fptr[3]))
1263 {
1264 if (fptr[1] == ((const UInt *)CONST_ADDR_OBJ(val))[fptr[0]])
1265 {
1266 l = LEN_PLIST(stack);
1267 i = l;
1268 do {
1269 x = INT_INTOBJ(ELM_PLIST(stack, i));
1270 ((UInt *)ADDR_OBJ(val))[x] = n+1;
1271 i--;
1272 } while (x != fptr[0]);
1273 comp = NEW_PLIST(T_PLIST_CYC, l-i);
1274 SET_LEN_PLIST(comp, l-i);
1275 memcpy( (char *)(ADDR_OBJ(comp)) + sizeof(Obj),
1276 (const char *)(CONST_ADDR_OBJ(stack)) + (i+1)*sizeof(Obj),
1277 (size_t)((l - i )*sizeof(Obj)));
1278 SET_LEN_PLIST(stack, i);
1279 l = LEN_PLIST(comps);
1280 SET_ELM_PLIST(comps, l+1, comp);
1281 SET_LEN_PLIST(comps, l+1);
1282 CHANGED_BAG(comps);
1283 fptr = (UInt *)ADDR_OBJ(frames)+(level-1)*4;
1284 }
1285 level--;
1286 fptr -= 4;
1287 if (level > 0 && fptr[5] < fptr[1])
1288 fptr[1] = fptr[5];
1289 }
1290 else
1291 {
1292 adj = (Obj)fptr[3];
1293 t = INT_INTOBJ(ELM_PLIST(adj, (fptr[2])++));
1294 m = ((const UInt *)CONST_ADDR_OBJ(val))[t];
1295 if (0 == m)
1296 {
1297 level++;
1298 adj = ELM_LIST(digraph, t);
1299 PLAIN_LIST(adj);
1300 fptr = (UInt *)ADDR_OBJ(frames)+(level-1)*4;
1301 fptr[0] = t;
1302 now++;
1303 ((UInt *)ADDR_OBJ(val))[t] = now;
1304 fptr[1] = now;
1305 l = LEN_PLIST(stack);
1306 SET_ELM_PLIST(stack, l+1, INTOBJ_INT(t));
1307 SET_LEN_PLIST(stack, l+1);
1308 fptr[2] = 1;
1309 fptr[3] = (UInt)adj;
1310 }
1311 else
1312 {
1313 if (m < fptr[1])
1314 fptr[1] = m;
1315 }
1316 }
1317 }
1318 }
1319
1320 }
1321 SHRINK_PLIST(comps, LEN_PLIST(comps));
1322 return comps;
1323 }
1324
1325
1326 /****************************************************************************
1327 **
1328 *F FuncCOPY_LIST_ENTRIES( <self>, <args> ) . . mass move of list entries
1329 **
1330 ** Argument names in the manual: fromlst, fromind, fromstep, tolst, toind, tostep, n
1331 */
1332
FuncCOPY_LIST_ENTRIES(Obj self,Obj args)1333 static Obj FuncCOPY_LIST_ENTRIES(Obj self, Obj args)
1334 {
1335 Obj srclist;
1336 Int srcstart;
1337 Int srcinc;
1338 Obj dstlist;
1339 Int dststart;
1340 Int dstinc;
1341 UInt number;
1342 UInt srcmax;
1343 UInt dstmax;
1344 const Obj *sptr;
1345 Obj *dptr;
1346 UInt ct;
1347
1348 GAP_ASSERT(IS_PLIST(args));
1349 if (LEN_PLIST(args) != 7) {
1350 ErrorMayQuitNrArgs(7, LEN_PLIST(args));
1351 }
1352 srclist = ELM_PLIST(args, 1);
1353 GAP_ASSERT(srclist != 0);
1354 if (!IS_PLIST(srclist))
1355 RequireArgumentEx("CopyListEntries", srclist, "<fromlst>",
1356 "must be a plain list");
1357
1358 srcstart = GetSmallIntEx("CopyListEntries", ELM_PLIST(args, 2), "<fromind>");
1359 srcinc = GetSmallIntEx("CopyListEntries", ELM_PLIST(args, 3), "<fromstep>");
1360 dstlist = ELM_PLIST(args,4);
1361 GAP_ASSERT(dstlist != 0);
1362 if (!IS_PLIST(dstlist) || !IS_MUTABLE_OBJ(dstlist))
1363 RequireArgumentEx("CopyListEntries", dstlist, "<tolst>",
1364 "must be a mutable plain list");
1365 dststart = GetSmallIntEx("CopyListEntries", ELM_PLIST(args, 5), "<toind>");
1366 dstinc = GetSmallIntEx("CopyListEntries", ELM_PLIST(args, 6), "<tostep>");
1367 number = GetSmallIntEx("CopyListEntries", ELM_PLIST(args, 7), "<n>");
1368
1369 if (number == 0)
1370 return (Obj) 0;
1371
1372 if ( srcstart <= 0 || dststart <= 0 ||
1373 srcstart + (number-1)*srcinc <= 0 || dststart + (number-1)*dstinc <= 0)
1374 {
1375 ErrorMayQuit("CopyListEntries: list indices must be positive integers",
1376 0, 0);
1377 }
1378
1379 srcmax = (srcinc > 0) ? srcstart + (number-1)*srcinc : srcstart;
1380 dstmax = (dstinc > 0) ? dststart + (number-1)*dstinc : dststart;
1381
1382 GROW_PLIST(dstlist, dstmax);
1383 GROW_PLIST(srclist, srcmax);
1384 if (srcinc == 1 && dstinc == 1)
1385 {
1386 SyMemmove(ADDR_OBJ(dstlist) + dststart,
1387 CONST_ADDR_OBJ(srclist) + srcstart,
1388 (size_t) number*sizeof(Obj));
1389 }
1390 else if (srclist != dstlist)
1391 {
1392 sptr = CONST_ADDR_OBJ(srclist) + srcstart;
1393 dptr = ADDR_OBJ(dstlist) + dststart;
1394 for (ct = 0; ct < number ; ct++)
1395 {
1396 *dptr = *sptr;
1397 sptr += srcinc;
1398 dptr += dstinc;
1399 }
1400 }
1401 else if (srcinc == dstinc)
1402 {
1403 if (srcstart == dststart)
1404 return (Obj)0;
1405 else
1406 {
1407 if ((srcstart > dststart) == (srcinc > 0))
1408 {
1409 sptr = CONST_ADDR_OBJ(srclist) + srcstart;
1410 dptr = ADDR_OBJ(srclist) + dststart;
1411 for (ct = 0; ct < number ; ct++)
1412 {
1413 *dptr = *sptr;
1414 sptr += srcinc;
1415 dptr += srcinc;
1416 }
1417 }
1418 else
1419 {
1420 sptr = CONST_ADDR_OBJ(srclist) + srcstart + number*srcinc;
1421 dptr = ADDR_OBJ(srclist) + dststart + number*srcinc;
1422 for (ct = 0; ct < number; ct++)
1423 {
1424 sptr -= srcinc;
1425 dptr -= srcinc;
1426 *dptr = *sptr;
1427 }
1428
1429 }
1430 }
1431
1432 }
1433 else
1434 {
1435 Obj tmplist = NEW_PLIST(T_PLIST,number);
1436 sptr = CONST_ADDR_OBJ(srclist)+srcstart;
1437 dptr = ADDR_OBJ(tmplist)+1;
1438 for (ct = 0; ct < number; ct++)
1439 {
1440 *dptr = *sptr;
1441 dptr++;
1442 sptr += srcinc;
1443 }
1444 sptr = CONST_ADDR_OBJ(tmplist)+1;
1445 dptr = ADDR_OBJ(srclist)+dststart;
1446 for (ct = 0; ct < number; ct++)
1447 {
1448 *dptr = *sptr;
1449 sptr++;
1450 dptr += dstinc;
1451 }
1452 }
1453
1454 if (dstmax > LEN_PLIST(dstlist))
1455 {
1456 sptr = CONST_ADDR_OBJ(dstlist)+dstmax;
1457 ct = dstmax;
1458 while (!*sptr)
1459 {
1460 ct--;
1461 sptr--;
1462 }
1463 SET_LEN_PLIST(dstlist, ct);
1464 }
1465 if (LEN_PLIST(dstlist) > 0)
1466 RetypeBag(dstlist, T_PLIST);
1467 else
1468 RetypeBag(dstlist, T_PLIST_EMPTY);
1469 return (Obj) 0;
1470
1471 }
1472
1473
FuncLIST_WITH_IDENTICAL_ENTRIES(Obj self,Obj n,Obj obj)1474 static Obj FuncLIST_WITH_IDENTICAL_ENTRIES(Obj self, Obj n, Obj obj)
1475 {
1476 RequireNonnegativeSmallInt("LIST_WITH_IDENTICAL_ENTRIES", n);
1477
1478 Obj list = 0;
1479 Int len = INT_INTOBJ(n);
1480 UInt tnum = TNUM_OBJ(obj);
1481
1482 if (tnum == T_CHAR) {
1483 list = NEW_STRING(len);
1484 memset(CHARS_STRING(list), CHAR_VALUE(obj), len);
1485 }
1486 else if (obj == True || obj == False) {
1487 list = NewBag(T_BLIST, SIZE_PLEN_BLIST(len));
1488 SET_LEN_BLIST(list, len);
1489 if (obj == True) {
1490 UInt * ptrBlist = BLOCKS_BLIST(list);
1491 for (; len >= BIPEB; len -= BIPEB)
1492 *ptrBlist++ = ~(UInt)0;
1493 if (len > 0)
1494 *ptrBlist |= (1UL << len) - 1;
1495 }
1496 }
1497 else if (len == 0) {
1498 list = NewEmptyPlist();
1499 }
1500 else {
1501 switch (tnum) {
1502 case T_INT:
1503 case T_INTPOS:
1504 case T_INTNEG:
1505 case T_RAT:
1506 case T_CYC:
1507 tnum = T_PLIST_CYC;
1508 break;
1509 case T_FFE:
1510 tnum = T_PLIST_FFE;
1511 break;
1512 default:
1513 tnum = T_PLIST_HOM;
1514 break;
1515 }
1516 list = NEW_PLIST(tnum, len);
1517 for (int i = 1; i <= len; i++) {
1518 SET_ELM_PLIST(list, i, obj);
1519 }
1520 CHANGED_BAG(list);
1521 SET_LEN_PLIST(list, len);
1522 }
1523
1524 return list;
1525 }
1526
1527 /****************************************************************************
1528 **
1529 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
1530 */
1531
1532
1533 /****************************************************************************
1534 **
1535 *V GVarOpers . . . . . . . . . . . . . . . . . list of operations to export
1536 */
1537 static StructGVarOper GVarOpers [] = {
1538
1539 // ADD_LIST can take 2 or 3 arguments; since NewOperation ignores the
1540 // handler for variadic operations, use DoOperation0Args as a placeholder.
1541 { "ADD_LIST", -1, "list, obj[, pos]", &AddListOper,
1542 DoOperation0Args, "src/listfunc.c:ADD_LIST" },
1543
1544 GVAR_OPER(REM_LIST, 1, "list", &RemListOper),
1545 GVAR_OPER(APPEND_LIST, 2, "list, val", &AppendListOper),
1546 { 0, 0, 0, 0, 0, 0 }
1547
1548 };
1549
1550
1551 /****************************************************************************
1552 **
1553 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1554 */
1555 static StructGVarFunc GVarFuncs [] = {
1556
1557 GVAR_FUNC(APPEND_LIST_INTR, 2, "list1, list2"),
1558 GVAR_FUNC(POSITION_SORTED_LIST, 2, "list, obj"),
1559 GVAR_FUNC(POSITION_SORTED_LIST_COMP, 3, "list, obj, func"),
1560 GVAR_FUNC(POSITION_SORTED_BY, 3, "list, val, func"),
1561 GVAR_FUNC(SORT_LIST, 1, "list"),
1562 GVAR_FUNC(STABLE_SORT_LIST, 1, "list"),
1563 GVAR_FUNC(SORT_LIST_COMP, 2, "list, func"),
1564 GVAR_FUNC(STABLE_SORT_LIST_COMP, 2, "list, func"),
1565 GVAR_FUNC(SORT_PARA_LIST, 2, "list, list"),
1566 GVAR_FUNC(STABLE_SORT_PARA_LIST, 2, "list, list"),
1567 GVAR_FUNC(SORT_PARA_LIST_COMP, 3, "list, list, func"),
1568 GVAR_FUNC(STABLE_SORT_PARA_LIST_COMP, 3, "list, list, func"),
1569 GVAR_FUNC(OnPoints, 2, "pnt, elm"),
1570 GVAR_FUNC(OnPairs, 2, "pair, elm"),
1571 GVAR_FUNC(OnTuples, 2, "tuple, elm"),
1572 GVAR_FUNC(OnSets, 2, "set, elm"),
1573 GVAR_FUNC(OnRight, 2, "pnt, elm"),
1574 GVAR_FUNC(OnLeftInverse, 2, "pnt, elm"),
1575 GVAR_FUNC(COPY_LIST_ENTRIES, -1, "srclist,srcstart,srcinc,dstlist,dststart,dstinc,number"),
1576 GVAR_FUNC(STRONGLY_CONNECTED_COMPONENTS_DIGRAPH, 1, "digraph"),
1577 GVAR_FUNC(LIST_WITH_IDENTICAL_ENTRIES, 2, "n, obj"),
1578 { 0, 0, 0, 0, 0 }
1579
1580 };
1581
1582
1583 /****************************************************************************
1584 **
1585 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1586 */
InitKernel(StructInitInfo * module)1587 static Int InitKernel (
1588 StructInitInfo * module )
1589 {
1590 /* init filters and functions */
1591 /* ADD_LIST needs special consideration because we want distinct kernel
1592 handlers for 2 and 3 arguments */
1593 InitHandlerFunc( FuncADD_LIST, "src/listfunc.c:FuncADD_LIST" );
1594 InitHandlerFunc( FuncADD_LIST3, "src/listfunc.c:FuncADD_LIST3" );
1595
1596 InitHdlrOpersFromTable( GVarOpers );
1597 InitHdlrFuncsFromTable( GVarFuncs );
1598
1599
1600
1601 /* return success */
1602 return 0;
1603 }
1604
1605
1606 /****************************************************************************
1607 **
1608 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
1609 */
InitLibrary(StructInitInfo * module)1610 static Int InitLibrary (
1611 StructInitInfo * module )
1612 {
1613 /* init filters and functions */
1614 InitGVarOpersFromTable( GVarOpers );
1615 InitGVarFuncsFromTable( GVarFuncs );
1616
1617 /* make and install the 'ADD_LIST' operation */
1618 SET_HDLR_FUNC( AddListOper, 2, FuncADD_LIST);
1619 SET_HDLR_FUNC( AddListOper, 3, FuncADD_LIST3);
1620
1621 /* return success */
1622 return 0;
1623 }
1624
1625
1626 /****************************************************************************
1627 **
1628 *F InitInfoListFunc() . . . . . . . . . . . . . . . table of init functions
1629 */
1630 static StructInitInfo module = {
1631 // init struct using C99 designated initializers; for a full list of
1632 // fields, please refer to the definition of StructInitInfo
1633 .type = MODULE_BUILTIN,
1634 .name = "listfunc",
1635 .initKernel = InitKernel,
1636 .initLibrary = InitLibrary,
1637 };
1638
InitInfoListFunc(void)1639 StructInitInfo * InitInfoListFunc ( void )
1640 {
1641 return &module;
1642 }
1643