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 of the generic list package.
11 **
12 ** This package provides a uniform interface to the functions that access
13 ** lists and their elements for the other packages in the GAP kernel. For
14 ** example, 'ExecFor' can loop over the elements in a list using 'LEN_LIST'
15 ** and 'ELM_LIST' independently of the type of the list.
16 **
17 ** This package uses plain lists (of type 'T_PLIST') and assumes that it is
18 ** possible to put values of any type into these. It uses the functions
19 ** 'LEN_PLIST', 'SET_LEN_PLIST', 'ELM_PLIST', and 'SET_ELM_PLIST' exported
20 ** by the plain list package to access and modify plain lists.
21 */
22
23 #include "lists.h"
24
25 #include "ariths.h"
26 #include "bool.h"
27 #include "calls.h"
28 #include "error.h"
29 #include "gapstate.h"
30 #include "gaputils.h"
31 #include "integer.h"
32 #include "io.h"
33 #include "modules.h"
34 #include "opers.h"
35 #include "plist.h"
36 #include "precord.h"
37 #include "range.h"
38 #include "records.h"
39 #include "stringobj.h"
40
41 #ifdef HPCGAP
42 #include "hpc/aobjects.h"
43 #include "hpc/guards.h"
44 #endif
45
46 /****************************************************************************
47 **
48 *F IS_LIST(<obj>) . . . . . . . . . . . . . . . . . . . is an object a list
49 *V IsListFuncs[<type>] . . . . . . . . . . . . . . . . . table for list test
50 **
51 ** 'IS_LIST' only calls the function pointed to by 'IsListFuncs[<type>]',
52 ** passing <obj> as argument.
53 */
54 Int (*IsListFuncs [LAST_REAL_TNUM+1]) ( Obj obj );
55
56 static Obj IsListFilt;
57
FiltIS_LIST(Obj self,Obj obj)58 static Obj FiltIS_LIST(Obj self, Obj obj)
59 {
60 return (IS_LIST( obj ) ? True : False);
61 }
62
IsListObject(Obj obj)63 static Int IsListObject(Obj obj)
64 {
65 return (DoFilter( IsListFilt, obj ) == True);
66 }
67
68
69 /****************************************************************************
70 **
71 *F IS_SMALL_LIST(<obj>) . . . . . . . . . . . . . . . . . . . is an object a list
72 *V IsListFuncs[<type>] . . . . . . . . . . . . . . . . . table for list test
73 **
74 ** 'IS_SMALL_LIST' only calls the function pointed to by 'IsListFuncs[<type>]',
75 ** passing <obj> as argument.
76 **
77 ** This is, in some sense, a workaround for the not yet implemented features
78 ** below (see LENGTH).
79 */
80 Int (*IsSmallListFuncs [LAST_REAL_TNUM+1]) ( Obj obj );
81
82 static Obj IsSmallListFilt;
83 static Obj HasIsSmallListFilt;
84 static Obj LengthAttr;
85 static Obj SetIsSmallList;
86
IsSmallListObject(Obj obj)87 static Int IsSmallListObject(Obj obj)
88 {
89 Obj len;
90 if (DoFilter(IsListFilt, obj) != True)
91 return 0;
92 if (DoFilter(HasIsSmallListFilt, obj) == True)
93 return DoFilter(IsSmallListFilt, obj) == True;
94 if (DoTestAttribute(LengthAttr, obj) == True)
95 {
96 len = DoAttribute(LengthAttr, obj);
97 if (IS_INTOBJ(len))
98 {
99 CALL_2ARGS(SetIsSmallList, obj, True);
100 return 1;
101 }
102 else
103 {
104 CALL_2ARGS(SetIsSmallList, obj, False);
105 return 0;
106 }
107 }
108 return 0;
109 }
110
111
112
113 /****************************************************************************
114 **
115 *F AttrLENGTH( <self>, <list> ) . . . . . . . . . . . 'Length' interface
116 **
117 ** There are the ``relatively'' easy changes to 'LEN_LIST' to allow it
118 ** return GAP objects instead of small C integers, but then the kernel has
119 ** to be very careful not to assume that the length is small and most of the
120 ** code has to duplicated, namely one large and one small version. So
121 ** instead the following solution has been taken:
122 **
123 ** - internal lists have always a small length, that means that it is not
124 ** possible to have plain list of length larger than 2^28 (or maybe 2^32)
125 ** on 32-bit machines, 'LEN_LIST' can only be applied to internal objects,
126 ** 'LENGTH' is the GAP interface for all kind of objects
127 **
128 ** - on the other hand we want ranges to have large start and end points,
129 ** therefore ranges are no longer *internal* objects, they are now
130 ** external objects (NOT YET IMPLEMENTED)
131 **
132 ** - the for/list assignment has to be carefull to catch the special case of
133 ** a range constructor with small integer bounds
134 **
135 ** - the list access/assigment is a binary operation (NOT YET IMPLEMENTED)
136 **
137 ** - the conversion/test functions are split into three different functions
138 ** (NOT YET IMPLEMENTED)
139 **
140 ** - 'ResetFilterObj' and 'SetFilterObj' are implemented using a table for
141 ** internal types (NOT YET IMPLEMENTED)
142 */
143
AttrLENGTH(Obj self,Obj list)144 static Obj AttrLENGTH(Obj self, Obj list)
145 {
146 /* internal list types */
147 #ifdef HPCGAP
148 ReadGuard(list);
149 ImpliedWriteGuard(list);
150 if ( (FIRST_LIST_TNUM<=TNUM_OBJ(list) && TNUM_OBJ(list)<=LAST_LIST_TNUM)
151 || TNUM_OBJ(list) == T_ALIST || TNUM_OBJ(list) == T_FIXALIST) {
152 return ObjInt_Int( LEN_LIST(list) );
153 }
154 #else
155 if ( FIRST_LIST_TNUM<=TNUM_OBJ(list) && TNUM_OBJ(list)<=LAST_LIST_TNUM) {
156 return ObjInt_Int( LEN_LIST(list) );
157 }
158 #endif
159
160 /* external types */
161 else {
162 return DoAttribute( LengthAttr, list );
163 }
164 }
165
166
167 /****************************************************************************
168 **
169 *F LEN_LIST(<list>) . . . . . . . . . . . . . . . . . . . length of a list
170 *V LenListFuncs[<type>] . . . . . . . . . . . . . table of length functions
171 *F LenListError(<list>) . . . . . . . . . . . . . . . error length function
172 **
173 ** 'LEN_LIST' only calls the function pointed to by 'LenListFuncs[<type>]',
174 ** passing <list> as argument. If <type> is not the type of a list, then
175 ** 'LenListFuncs[<type>]' points to 'LenListError', which just signals an
176 ** error.
177 **
178 ** At the moment this also handles external types but this is a hack,
179 ** because external lists can have large length or even be infinite. See
180 ** 'AttrLENGTH'.
181 */
182 Int (*LenListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
183
FuncLEN_LIST(Obj self,Obj list)184 static Obj FuncLEN_LIST(Obj self, Obj list)
185 {
186 /* special case for plain lists (avoid conversion back and forth) */
187 if ( IS_PLIST(list) ) {
188 return INTOBJ_INT( LEN_PLIST( list ) );
189 }
190
191 /* generic case (will signal an error if <list> is not a list) */
192 else {
193 return AttrLENGTH( LengthAttr, list );
194 }
195 }
196
197
LenListError(Obj list)198 static Int LenListError(Obj list)
199 {
200 RequireArgument("Length", list, "must be a list");
201 }
202
203
LenListObject(Obj obj)204 static Int LenListObject(Obj obj)
205 {
206 Obj len;
207
208 len = AttrLENGTH( LengthAttr, obj );
209 if (!IS_NONNEG_INTOBJ(len)) {
210 RequireArgumentEx("Length", len, 0,
211 "method must return a non-negative value");
212 }
213 return INT_INTOBJ( len );
214 }
215
216 /****************************************************************************
217 **
218 *F LENGTH(<list>) . . . . . . . . . . . . . . . . . . . length of a list
219 *V LengthFuncs[<type>] . . . . . . . . . . . . . table of length functions
220 **
221 ** 'LENGTH' returns the logical length of the list <list> as a GAP object
222 ** An error is signalled if <list> is not a list.
223 **
224 ** A package implementing a list type <type> must provide such a function
225 ** and install it in 'LengthFuncs[<type>]'.
226 */
227
228 Obj (*LengthFuncs[LAST_REAL_TNUM+1]) ( Obj list );
229
LengthError(Obj list)230 static Obj LengthError(Obj list)
231 {
232 RequireArgument("Length", list, "must be a list");
233 }
234
235
LengthObject(Obj obj)236 static Obj LengthObject(Obj obj)
237 {
238 return AttrLENGTH( LengthAttr, obj );
239 }
240
LengthInternal(Obj obj)241 static Obj LengthInternal(Obj obj)
242 {
243 return INTOBJ_INT(LEN_LIST(obj));
244 }
245
246
247
248
249 /****************************************************************************
250 **
251 *F ISB_LIST(<list>,<pos>) . . . . . . . . . . test for element from a list
252 *V IsbListFuncs[<type>] . . . . . . . . . . . . . . table of test functions
253 **
254 ** 'ISB_LIST' only calls the function pointed to by 'IsbListFuncs[<type>]',
255 ** passing <list> and <pos> as arguments. If <type> is not the type of a
256 ** list, then 'IsbListFuncs[<type>]' points to 'IsbListError', which signals
257 ** the error.
258 */
259 Int (*IsbListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
260
261 static Obj IsbListOper;
262
FuncISB_LIST(Obj self,Obj list,Obj pos)263 static Obj FuncISB_LIST(Obj self, Obj list, Obj pos)
264 {
265 if (IS_POS_INTOBJ(pos))
266 return ISB_LIST( list, INT_INTOBJ(pos) ) ? True : False;
267 else
268 return ISBB_LIST( list, pos ) ? True : False;
269 }
270
IsbListError(Obj list,Int pos)271 static Int IsbListError(Obj list, Int pos)
272 {
273 RequireArgument("IsBound", list, "must be a list");
274 }
275
IsbListObject(Obj list,Int pos)276 static Int IsbListObject(Obj list, Int pos)
277 {
278 return DoOperation2Args( IsbListOper, list, INTOBJ_INT(pos) ) == True;
279 }
280
ISBB_LIST(Obj list,Obj pos)281 Int ISBB_LIST (
282 Obj list,
283 Obj pos )
284 {
285 return DoOperation2Args( IsbListOper, list, pos ) == True;
286 }
287
ISB_MAT(Obj mat,Obj row,Obj col)288 Int ISB_MAT(Obj mat, Obj row, Obj col)
289 {
290 return DoOperation3Args(IsbListOper, mat, row, col) == True;
291 }
292
293
294 /****************************************************************************
295 **
296 *F * * * * * * * * * * * * list access functions * * * * * * * * * * * * * *
297 */
298
299
300 /****************************************************************************
301 **
302 *V Elm0ListFuncs[ <type> ] . . . . . . . . . . table of selection functions
303 **
304 ** 'ELM0_LIST' returns the element at the position <pos> in the list <list>,
305 ** or 0 if <list> has no assigned object at position <pos>. An error is
306 ** signalled if <list> is not a list. It is the responsibility of the
307 ** caller to ensure that <pos> is a positive integer.
308 */
309 Obj (*Elm0ListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
310
311 /****************************************************************************
312 **
313 *V ElmDefListFuncs[ <type> ] . . . . . . . . . table of selection functions
314 **
315 ** 'ELM_DEFAULT_LIST' returns the element at the position <pos> in the list
316 ** <list>, or <default> if <list> has no assigned object at position <pos>.
317 ** An error is signalled if <list> is not a list. It is the responsibility
318 ** of the caller to ensure that <pos> is a positive integer.
319 */
320 Obj (*ElmDefListFuncs[LAST_REAL_TNUM + 1])(Obj list, Int pos, Obj def);
321
322 // Default implementation of ELM_DEFAULT_LIST
ElmDefListDefault(Obj list,Int pos,Obj def)323 static Obj ElmDefListDefault(Obj list, Int pos, Obj def)
324 {
325 Obj val = ELM0_LIST(list, pos);
326 if (val) {
327 return val;
328 }
329 else {
330 return def;
331 }
332 }
333
334 /****************************************************************************
335 **
336 *F ElmDefListObject( <list>, <pos>, <default> )select an element from a list
337 **
338 ** `ElmDefListObject' is the `ELM_DEFAULT_LIST' function for objects.
339 **
340 */
341 static Obj ElmDefListOper;
342
ElmDefListObject(Obj list,Int pos,Obj def)343 static Obj ElmDefListObject(Obj list, Int pos, Obj def)
344 {
345 return DoOperation3Args(ElmDefListOper, list, INTOBJ_INT(pos), def);
346 }
347
FuncELM_DEFAULT_LIST(Obj self,Obj list,Obj pos,Obj def)348 static Obj FuncELM_DEFAULT_LIST(Obj self, Obj list, Obj pos, Obj def)
349 {
350 Int ipos = GetPositiveSmallInt("GetWithDefault", pos);
351 return ELM_DEFAULT_LIST(list, ipos, def);
352 }
353
354 /****************************************************************************
355 **
356 *V Elm0vListFuncs[ <type> ] . . . . . . . . . table of selection functions
357 **
358 ** 'ELMV0_LIST' does the same as 'ELM0_LIST', but the caller also guarantees
359 ** that <list> is a list and that <pos> is less than or equal to the length
360 ** of <list>.
361 */
362 Obj (*Elm0vListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
363
364
365 /****************************************************************************
366 **
367 *F Elm0ListError( <list>, <pos> ) . . . . . . . . . . . . . . error message
368 */
Elm0ListError(Obj list,Int pos)369 static Obj Elm0ListError(Obj list, Int pos)
370 {
371 RequireArgument("List Element", list, "must be a list");
372 }
373
374
375 /****************************************************************************
376 **
377 *F Elm0ListObject( <list>, <pos> ) . . . . . . select an element from a list
378 **
379 ** `Elm0ListObject' is the `ELM0_LIST' and `ELMV0_LIST' function for
380 ** objects. The function returns the element at the position <pos> of the
381 ** list object <list>, or 0 if <list> has no assigned object at <pos>. It
382 ** is the responsibility of the caller to ensure that <pos> is a positive
383 ** integer.
384 **
385 ** Note that the method returns `Fail' if there is no entry at position
386 ** <pos>, in this case `Elm0ListObject' must check if the position is bound
387 ** and `Fail' means that there realy is the object `Fail' at this position
388 ** or if it is unbound in which case 0 is returned.
389 */
390 static Obj Elm0ListOper;
391
Elm0ListObject(Obj list,Int pos)392 static Obj Elm0ListObject(Obj list, Int pos)
393 {
394 Obj elm;
395
396 elm = DoOperation2Args( Elm0ListOper, list, INTOBJ_INT(pos) );
397
398 if ( elm == Fail ) {
399 if ( DoOperation2Args(IsbListOper,list,INTOBJ_INT(pos)) == True )
400 return Fail;
401 else
402 return 0;
403 } else {
404 return elm;
405 }
406 }
407
408
409 /****************************************************************************
410 **
411 *F FuncELM0_LIST( <self>, <list>, <pos> ) . . . . . . operation `ELM0_LIST'
412 */
FuncELM0_LIST(Obj self,Obj list,Obj pos)413 static Obj FuncELM0_LIST(Obj self, Obj list, Obj pos)
414 {
415 Obj elm;
416 elm = ELM0_LIST( list, INT_INTOBJ(pos) );
417 if ( elm == 0 ) {
418 return Fail;
419 }
420 else {
421 return elm;
422 }
423 }
424
425 /****************************************************************************
426 **
427 *V ElmListFuncs[<type>] . . . . . . . . . . . table of selection functions
428 **
429 ** 'ELM_LIST' returns the element at the position <pos> in the list <list>.
430 ** An error is signalled if <list> is not a list, if <pos> is larger than
431 ** the length of <list>, or if <list> has no assigned object at <pos>. It
432 ** is the responsibility of the caller to ensure that <pos> is a positive
433 ** integer.
434 **
435 ** 'ELM_LIST' only calls the functions pointed to by 'ElmListFuncs[<type>]'
436 ** passing <list> and <pos> as arguments. If <type> is not the type of a
437 ** list, then 'ElmListFuncs[<type>]' points to 'ElmListError', which signals
438 ** the error.
439 */
440 Obj (*ElmListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
441
442
443 /****************************************************************************
444 **
445 *V ElmvListFuncs[<type>] . . . . . . . . . . . table of selection functions
446 **
447 ** 'ELMV_LIST' does the same as 'ELM_LIST', but the caller also guarantees
448 ** that <list> is a list and that <pos> is less than or equal to the length
449 ** of <list>.
450 */
451 Obj (*ElmvListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
452
453
454 /****************************************************************************
455 **
456 *V ElmwListFuncs[<type>] . . . . . . . . . . . table of selection functions
457 **
458 ** 'ELMW_LIST' does the same as 'ELMV_LIST', but the caller also guarantees
459 ** that <list> has an assigned object at the position <pos>.
460 */
461 Obj (*ElmwListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
462
463
464 /****************************************************************************
465 **
466 *F ElmListError( <list>, <pos> ) . . . . . . . . . . . . . . . error message
467 */
ElmListError(Obj list,Int pos)468 static Obj ElmListError(Obj list, Int pos)
469 {
470 RequireArgument("List Element", list, "must be a list");
471 }
472
473
474 /****************************************************************************
475 **
476 *F ElmListObject( <list>, <pos> . . . . . . . select an element from a list
477 **
478 ** `ElmListObject' is the `ELM_LIST', `ELMV_LIST', and `ELMW_LIST' function
479 ** for objects. 'ElmListObjects' selects the element at position <pos> of
480 ** list object <list>. It is the responsibility of the caller to ensure
481 ** that <pos> is a positive integer. The methods have to signal an error if
482 ** <pos> is larger than the length of <list> or if the entry is not bound.
483 */
484 static Obj ElmListOper;
485
ElmListObject(Obj list,Int pos)486 static Obj ElmListObject(Obj list, Int pos)
487 {
488 return ELMB_LIST( list, INTOBJ_INT(pos) );
489 }
490
491
ELMB_LIST(Obj list,Obj pos)492 Obj ELMB_LIST(Obj list, Obj pos)
493 {
494 Obj elm;
495
496 elm = DoOperation2Args( ElmListOper, list, pos );
497 if (elm == 0) {
498 ErrorMayQuit("List access method must return a value", 0, 0);
499 }
500 return elm;
501 }
502
503
504 /****************************************************************************
505 **
506 *F FuncELM_MAT( <self>, <mat>, <row>, <col> ) . . . . . operation `ELM_MAT'
507 */
FuncELM_MAT(Obj self,Obj mat,Obj row,Obj col)508 static Obj FuncELM_MAT(Obj self, Obj mat, Obj row, Obj col)
509 {
510 return ELM_MAT(mat, row, col);
511 }
512
513 static Obj ElmMatOper;
514
ELM_MAT(Obj mat,Obj row,Obj col)515 Obj ELM_MAT(Obj mat, Obj row, Obj col)
516 {
517 if (IS_POS_INTOBJ(row) && IS_POS_INTOBJ(col) && IS_PLIST(mat)) {
518 Int r = INT_INTOBJ(row);
519 if (r <= LEN_PLIST(mat)) {
520 Obj rowlist = ELM_PLIST(mat, r);
521 Int c = INT_INTOBJ(col);
522
523 if (IS_PLIST(rowlist) && c <= LEN_PLIST(rowlist)) {
524 return ELM_PLIST(rowlist, c);
525 }
526
527 // fallback to generic list access code (also triggers error if
528 // row isn't a list)
529 return ELM_LIST(rowlist, c);
530 }
531 }
532
533 Obj elm = DoOperation3Args(ElmMatOper, mat, row, col);
534 if (elm == 0) {
535 ErrorMayQuit("Matrix access method must return a value", 0, 0);
536 }
537 return elm;
538 }
539
540
541 /****************************************************************************
542 **
543 *F FuncELM_LIST( <self>, <list>, <pos> ) . . . . . . . operation `ELM_LIST'
544 */
FuncELM_LIST(Obj self,Obj list,Obj pos)545 static Obj FuncELM_LIST(Obj self, Obj list, Obj pos)
546 {
547 if (IS_POS_INTOBJ(pos))
548 return ELM_LIST(list, INT_INTOBJ(pos));
549 else
550 return ELMB_LIST(list, pos);
551 }
552
553
554 /****************************************************************************
555 **
556 *V ElmsListFuncs[<type>] . . . . . . . . . . . table of selection functions
557 **
558 ** 'ELMS_LIST' returns a new list containing the elements at the positions
559 ** given in the list <poss> from the <list>. It is the responsibility of
560 ** the caller to ensure that <poss> is dense and contains only positive
561 ** integers. An error is signalled if an element of <poss> is larger than
562 ** the length of <list>.
563 **
564 ** 'ELMS_LIST' only calls the function pointed to by
565 ** 'ElmsListFuncs[<type>]', passing <list> and <poss> as arguments. If
566 ** <type> is not the type of a list, then 'ElmsListFuncs[<type>]' points to
567 ** 'ElmsListError', which just signals an error.
568 */
569 Obj (*ElmsListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Obj poss );
570
571
572 /****************************************************************************
573 **
574 *F ElmsListError(<list>,<poss>) . . . . . . . . . error selection function
575 */
ElmsListError(Obj list,Obj poss)576 static Obj ElmsListError(Obj list, Obj poss)
577 {
578 RequireArgument("List Elements", list, "must be a list");
579 }
580
581
582 /****************************************************************************
583 **
584 *F ElmsListObject( <list>, <pos> ) . . . . . . . select elements from a list
585 **
586 ** `ElmsListObject' is the `ELMS_LIST' function for objects.
587 */
588 static Obj ElmsListOper;
589
ElmsListObject(Obj list,Obj poss)590 static Obj ElmsListObject(Obj list, Obj poss)
591 {
592 Obj elm;
593
594 elm = DoOperation2Args( ElmsListOper, list, poss );
595 if (elm == 0) {
596 ErrorMayQuit("List multi-access method must return a value", 0, 0);
597 }
598 return elm;
599 }
600
601
602 /****************************************************************************
603 **
604 *F FuncELMS_LIST( <self>, <list>, <poss> ) . . . . . . `ELMS_LIST' operation
605 */
FuncELMS_LIST(Obj self,Obj list,Obj poss)606 static Obj FuncELMS_LIST(Obj self, Obj list, Obj poss)
607 {
608 return ElmsListCheck( list, poss );
609 }
610
611
612 /****************************************************************************
613 **
614 *F ElmsListDefault( <list>, <poss> ) . . . default function for `ELMS_LIST'
615 **
616 ** Create a new plain list as result. <list> must be small.
617 */
ElmsListDefault(Obj list,Obj poss)618 Obj ElmsListDefault (
619 Obj list,
620 Obj poss )
621 {
622 Obj elms; /* selected sublist, result */
623 Int lenList; /* length of <list> */
624 Obj elm; /* one element from <list> */
625 Int lenPoss; /* length of <positions> */
626 Int pos; /* <position> as integer */
627 Int inc; /* increment in a range */
628 Int i; /* loop variable */
629
630 /* general code */
631 if ( ! IS_RANGE(poss) ) {
632
633 /* get the length of <list> */
634 lenList = LEN_LIST( list );
635
636 /* get the length of <positions> */
637 /* OK because all positions lists are small */
638 lenPoss = LEN_LIST( poss );
639
640 /* make the result list */
641 elms = NEW_PLIST( T_PLIST, lenPoss );
642 SET_LEN_PLIST( elms, lenPoss );
643
644 /* loop over the entries of <positions> and select */
645 for ( i = 1; i <= lenPoss; i++ ) {
646
647 /* get <position> */
648 Obj p = ELMW_LIST(poss, i);
649 if (!IS_INTOBJ(p)) {
650 ErrorMayQuit("List Elements: position is too large for "
651 "this type of list",
652 0, 0);
653 }
654 pos = INT_INTOBJ(p);
655
656 /* select the element */
657 elm = ELM0_LIST( list, pos );
658 if ( elm == 0 ) {
659 ErrorMayQuit(
660 "List Elements: <list>[%d] must have an assigned value",
661 (Int)pos, 0);
662 }
663
664 /* assign the element into <elms> */
665 SET_ELM_PLIST( elms, i, elm );
666
667 /* notify Gasman */
668 CHANGED_BAG( elms );
669
670 }
671
672 }
673
674 /* special code for ranges */
675 else {
676
677 /* get the length of <list> */
678 lenList = LEN_LIST( list );
679
680 /* get the length of <positions>, the first elements, and the inc. */
681 lenPoss = GET_LEN_RANGE( poss );
682 pos = GET_LOW_RANGE( poss );
683 inc = GET_INC_RANGE( poss );
684
685 /* check that no <position> is larger than 'LEN_LIST(<list>)' */
686 if ( lenList < pos ) {
687 ErrorMayQuit(
688 "List Elements: <list>[%d] must have an assigned value",
689 (Int)pos, 0);
690 }
691 if ( lenList < pos + (lenPoss-1) * inc ) {
692 ErrorMayQuit(
693 "List Elements: <list>[%d] must have an assigned value",
694 (Int)pos + (lenPoss - 1) * inc, 0);
695 }
696
697 /* make the result list */
698 elms = NEW_PLIST( T_PLIST, lenPoss );
699 SET_LEN_PLIST( elms, lenPoss );
700
701 /* loop over the entries of <positions> and select */
702 for ( i = 1; i <= lenPoss; i++, pos += inc ) {
703
704 /* select the element */
705 elm = ELMV0_LIST( list, pos );
706 if ( elm == 0 ) {
707 ErrorMayQuit(
708 "List Elements: <list>[%d] must have an assigned value",
709 (Int)pos, 0);
710 }
711
712 /* assign the element to <elms> */
713 SET_ELM_PLIST( elms, i, elm );
714
715 /* notify Gasman */
716 CHANGED_BAG( elms );
717
718 }
719
720 }
721
722 /* return the result */
723 return elms;
724 }
725
726
727 /****************************************************************************
728 **
729 *F FuncELMS_LIST_DEFAULT( <self>, <list>, <poss> ) . . . . `ElmsListDefault'
730 */
FuncELMS_LIST_DEFAULT(Obj self,Obj list,Obj poss)731 static Obj FuncELMS_LIST_DEFAULT(Obj self, Obj list, Obj poss)
732 {
733 return ElmsListDefault( list, poss );
734 }
735
736
737 /****************************************************************************
738 **
739 *F ElmsListCheck( <list>, <poss> ) . . . . . . . . . . . . . . . . ELMS_LIST
740 **
741 ** `ElmsListCheck' checks that <poss> is a possitions lists before calling
742 ** `ELMS_LIST'.
743 */
ElmsListCheck(Obj list,Obj poss)744 Obj ElmsListCheck (
745 Obj list,
746 Obj poss )
747 {
748 CheckIsPossList("List Elements", poss);
749 return ELMS_LIST( list, poss );
750 }
751
752
753 /****************************************************************************
754 **
755 *F ElmsListLevelCheck( <lists>, <poss>, <level> ) . . . . . . ElmsListLevel
756 **
757 ** `ElmsListLevelCheck' checks that <poss> is a possitions lists before
758 ** calling `ElmsListLevel'.
759 */
ElmsListLevelCheck(Obj lists,Obj poss,Int level)760 void ElmsListLevelCheck (
761 Obj lists,
762 Obj poss,
763 Int level )
764 {
765 CheckIsPossList("List Elements", poss);
766 ElmsListLevel( lists, poss, level );
767 }
768
769
770 /****************************************************************************
771 **
772 *F UNB_LIST(<list>,<pos>) . . . . . . . . . . . unbind element from a list
773 *V UnbListFuncs[<type>] . . . . . . . . . . . . . table of unbind functions
774 *F UnbListError(<list>,<pos>) . . . . . . . . . . . . error unbind function
775 **
776 */
777 void (*UnbListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos );
778
779 static Obj UnbListOper;
780
FuncUNB_LIST(Obj self,Obj list,Obj pos)781 static Obj FuncUNB_LIST(Obj self, Obj list, Obj pos)
782 {
783 if (IS_POS_INTOBJ(pos))
784 UNB_LIST( list, INT_INTOBJ(pos) );
785 else
786 UNBB_LIST( list, pos );
787 return 0;
788 }
789
UnbListError(Obj list,Int pos)790 static void UnbListError(Obj list, Int pos)
791 {
792 RequireArgument("Unbind", list, "must be a list");
793 }
794
UnbListObject(Obj list,Int pos)795 static void UnbListObject(Obj list, Int pos)
796 {
797 DoOperation2Args( UnbListOper, list, INTOBJ_INT(pos) );
798 }
799
UNBB_LIST(Obj list,Obj pos)800 void UNBB_LIST (
801 Obj list,
802 Obj pos )
803 {
804 DoOperation2Args( UnbListOper, list, pos );
805 }
806
UNB_MAT(Obj mat,Obj row,Obj col)807 void UNB_MAT(Obj mat, Obj row, Obj col)
808 {
809 DoOperation3Args(UnbListOper, mat, row, col);
810 }
811
812
813 /****************************************************************************
814 **
815 *F ASS_LIST(<list>,<pos>,<obj>) . . . . . . . . assign an element to a list
816 *V AssListFuncs[<type>] . . . . . . . . . . . table of assignment functions
817 *F AssListError(<list>,<pos>,<obj>) . . . . . . . error assignment function
818 **
819 ** 'ASS_LIST' only calls the function pointed to by 'AssListFuncs[<type>]',
820 ** passing <list>, <pos>, and <obj> as arguments. If <type> is not the type
821 ** of a list, then 'AssListFuncs[<type>]' points to 'AssListError', which
822 ** just signals an error.
823 **
824 */
825 void (*AssListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Int pos, Obj obj );
826
827 static Obj AssListOper;
828
FuncASS_LIST(Obj self,Obj list,Obj pos,Obj obj)829 static Obj FuncASS_LIST(Obj self, Obj list, Obj pos, Obj obj)
830 {
831 if (IS_POS_INTOBJ(pos))
832 ASS_LIST(list, INT_INTOBJ(pos), obj);
833 else
834 ASSB_LIST(list, pos, obj);
835 return 0;
836 }
837
AssListError(Obj list,Int pos,Obj obj)838 static void AssListError(Obj list, Int pos, Obj obj)
839 {
840 RequireArgument("List Assignments", list, "must be a list");
841 }
842
843
844 /****************************************************************************
845 **
846 *F AssListObject( <list>, <pos>, <obj> ) . . . . . . . assign to list object
847 */
848
AssListObject(Obj list,Int pos,Obj obj)849 void AssListObject (
850 Obj list,
851 Int pos,
852 Obj obj )
853 {
854 DoOperation3Args( AssListOper, list, INTOBJ_INT(pos), obj );
855 }
856
ASSB_LIST(Obj list,Obj pos,Obj obj)857 void ASSB_LIST (
858 Obj list,
859 Obj pos,
860 Obj obj )
861 {
862 DoOperation3Args( AssListOper, list, pos, obj );
863 }
864
865 static Obj AssMatOper;
866
FuncASS_MAT(Obj self,Obj mat,Obj row,Obj col,Obj obj)867 static Obj FuncASS_MAT(Obj self, Obj mat, Obj row, Obj col, Obj obj)
868 {
869 ASS_MAT(mat, row, col, obj);
870 return 0;
871 }
872
ASS_MAT(Obj mat,Obj row,Obj col,Obj obj)873 void ASS_MAT(Obj mat, Obj row, Obj col, Obj obj)
874 {
875 RequireMutable("Matrix Assignment", mat, "matrix");
876 if (IS_POS_INTOBJ(row) && IS_POS_INTOBJ(col) && IS_PLIST(mat)) {
877 Int r = INT_INTOBJ(row);
878 if (r <= LEN_PLIST(mat)) {
879 Obj rowlist = ELM_PLIST(mat, r);
880 Int c = INT_INTOBJ(col);
881
882 ASS_LIST(rowlist, c, obj);
883 return;
884 }
885 }
886
887 DoOperation4Args(AssMatOper, mat, row, col, obj);
888 }
889
890
891 /****************************************************************************
892 **
893 *F ASSS_LIST(<list>,<poss>,<objs>) . . . . assign several elements to a list
894 *V AsssListFuncs[<type>] . . . . . . . . . . . table of assignment function
895 *F AsssListError(<list>,<poss>,<objs>) . . . . . . error assignment function
896 **
897 ** 'ASSS_LIST' only calls the function pointed to by
898 ** 'AsssListFuncs[<type>]', passing <list>, <poss>, and <objs> as arguments.
899 ** If <type> is not the type of a list, then 'AsssListFuncs[<type>]' points
900 ** to 'AsssListError', which just signals an error.
901 */
902 void (*AsssListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Obj poss, Obj objs );
903
904 static Obj AsssListOper;
905
FuncASSS_LIST(Obj self,Obj list,Obj poss,Obj objs)906 static Obj FuncASSS_LIST(Obj self, Obj list, Obj poss, Obj objs)
907 {
908 AsssListCheck( list, poss, objs );
909 return 0;
910 }
911
AsssListError(Obj list,Obj poss,Obj objs)912 static void AsssListError(Obj list, Obj poss, Obj objs)
913 {
914 RequireArgument("List Assignments", list, "must be a list");
915 }
916
AsssListDefault(Obj list,Obj poss,Obj objs)917 void AsssListDefault (
918 Obj list,
919 Obj poss,
920 Obj objs )
921 {
922 Int lenPoss; /* length of <positions> */
923 Obj p; /* <position> */
924 Int pos; /* <position> as integer */
925 Int inc; /* increment in a range */
926 Obj obj; /* one element from <objs> */
927 Int i; /* loop variable */
928
929 CheckIsPossList("List Assignments", poss);
930 CheckIsDenseList("List Assignments", "rhss", objs);
931 CheckSameLength("List Assignments", "rhss", "poss", objs, poss);
932
933 /* general code */
934 if ( ! IS_RANGE(poss) ) {
935
936 /* get the length of <positions> */
937 lenPoss = LEN_LIST( poss );
938
939 /* loop over the entries of <positions> and select */
940 for ( i = 1; i <= lenPoss; i++ ) {
941
942 /* get <position> */
943 p = ELMW_LIST( poss, i );
944
945 /* select the element */
946 obj = ELMW_LIST( objs, i );
947 if (IS_INTOBJ(p) )
948 {
949 /* assign the element into <elms> */
950 ASS_LIST( list, INT_INTOBJ(p), obj );
951 }
952 else
953 ASSB_LIST(list, p, obj);
954
955 }
956
957 }
958
959 /* special code for ranges */
960 else {
961
962 /* get the length of <positions> */
963 lenPoss = GET_LEN_RANGE( poss );
964 pos = GET_LOW_RANGE( poss );
965 inc = GET_INC_RANGE( poss );
966
967 /* loop over the entries of <positions> and select */
968 for ( i = 1; i <= lenPoss; i++, pos += inc ) {
969
970 /* select the element */
971 obj = ELMW_LIST( objs, i );
972
973 /* assign the element to <elms> */
974 ASS_LIST( list, pos, obj );
975
976 }
977
978 }
979
980 }
981
AsssListObject(Obj list,Obj poss,Obj objs)982 static void AsssListObject(Obj list, Obj poss, Obj objs)
983 {
984 DoOperation3Args( AsssListOper, list, poss, objs );
985 }
986
FuncASSS_LIST_DEFAULT(Obj self,Obj list,Obj poss,Obj objs)987 static Obj FuncASSS_LIST_DEFAULT(Obj self, Obj list, Obj poss, Obj objs)
988 {
989 AsssListDefault( list, poss, objs );
990 return 0;
991 }
992
993
994 /****************************************************************************
995 **
996 *F IS_DENSE_LIST(<list>) . . . . . . . . . . . . . . . test for dense lists
997 *V IsDenseListFuncs[<type>] . . . . . . table for dense list test functions
998 **
999 ** 'IS_DENSE_LIST' only calls the function pointed to by
1000 ** 'IsDenseListFuncs[<type>]', passing <list> as argument. If <type> is not
1001 ** the type of a list, then 'IsDenseListFuncs[<type>]' points to
1002 ** 'AlwaysNo', which just returns 0.
1003 */
1004 Int (*IsDenseListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
1005
1006 static Obj IsDenseListFilt;
1007
FiltIS_DENSE_LIST(Obj self,Obj obj)1008 static Obj FiltIS_DENSE_LIST(Obj self, Obj obj)
1009 {
1010 return (IS_DENSE_LIST( obj ) ? True : False);
1011 }
1012
IsDenseListObject(Obj obj)1013 static Int IsDenseListObject(Obj obj)
1014 {
1015 return (DoFilter( IsDenseListFilt, obj ) == True);
1016 }
1017
1018
1019 /****************************************************************************
1020 **
1021 *F IS_HOMOG_LIST(<list>) . . . . . . . . . . . . test for homogeneous lists
1022 *V IsHomogListFuncs[<type>] . . . table for homogeneous list test functions
1023 **
1024 ** 'IS_HOMOG_LIST' only calls the function pointed to by
1025 ** 'IsHomogListFuncs[<type>]', passing <list> as argument. If <type> is not
1026 ** the type of a list, then 'IsHomogListFuncs[<type>]' points to
1027 ** 'AlwaysNo', which just returns 0.
1028 **
1029 */
1030 Int (*IsHomogListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
1031
1032 static Obj IsHomogListFilt;
1033
FiltIS_HOMOG_LIST(Obj self,Obj obj)1034 static Obj FiltIS_HOMOG_LIST(Obj self, Obj obj)
1035 {
1036 return (IS_HOMOG_LIST( obj ) ? True : False);
1037 }
1038
IsHomogListObject(Obj obj)1039 static Int IsHomogListObject(Obj obj)
1040 {
1041 return (DoFilter( IsHomogListFilt, obj ) == True);
1042 }
1043
1044
1045 /****************************************************************************
1046 **
1047 *F IS_TABLE_LIST(<list>) . . . . . . . . . . . . . . . test for table lists
1048 *V IsTableListFuncs[<type>] . . . . . . table for table list test functions
1049 **
1050 ** 'IS_TABLE_LIST' only calls the function pointed to by
1051 ** 'IsTableListFuncs[<type>]', passing <list> as argument. If <type> is not
1052 ** the type of a list, then 'IsTableListFuncs[<type>]' points to
1053 ** 'AlwaysNo', which just returns 0.
1054 */
1055 Int (*IsTableListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
1056
1057 static Obj IsTableListFilt;
1058
FiltIS_TABLE_LIST(Obj self,Obj obj)1059 static Obj FiltIS_TABLE_LIST(Obj self, Obj obj)
1060 {
1061 return (IS_TABLE_LIST( obj ) ? True : False);
1062 }
1063
IsTableListObject(Obj obj)1064 static Int IsTableListObject(Obj obj)
1065 {
1066 return (DoFilter( IsTableListFilt, obj ) == True);
1067 }
1068
1069
1070 /****************************************************************************
1071 **
1072 *F IS_SSORT_LIST( <list> ) . . . . . . . . . test for strictly sorted lists
1073 *V IsSSortListFuncs[<type>] . table of strictly sorted list test functions
1074 **
1075 ** 'IS_SSORT_LIST' only calls the function pointed to by
1076 ** 'IsSSortListFuncs[<type>]', passing <list> as argument.
1077 ** If <type> is not the type of a list, then 'IsSSortListFuncs[<type>]'
1078 ** points to 'AlwaysNo', which just returns 0.
1079 **
1080 */
1081 Int (*IsSSortListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
1082
1083 static Obj IsSSortListProp;
1084
PropIS_SSORT_LIST(Obj self,Obj obj)1085 static Obj PropIS_SSORT_LIST(Obj self, Obj obj)
1086 {
1087 return (IS_SSORT_LIST( obj ) ? True : False);
1088 }
1089
IsSSortListDefault(Obj list)1090 static Int IsSSortListDefault (
1091 Obj list )
1092 {
1093 Int lenList;
1094 Obj elm1;
1095 Obj elm2;
1096 Int i;
1097
1098 /* get the length of the list */
1099 lenList = LEN_LIST( list );
1100
1101 /* special case for the empty list */
1102 if ( lenList == 0 ) {
1103 return 2L;
1104 }
1105
1106 /* get the first element */
1107 elm1 = ELM0_LIST(list, 1);
1108
1109 if (!elm1) {
1110 return 0L;
1111 }
1112
1113 /* compare each element with its precursor */
1114 for ( i = 2; i <= lenList; i++ ) {
1115 elm2 = ELM0_LIST(list, i);
1116 if (!elm2) {
1117 return 0L;
1118 }
1119 if ( ! LT( elm1, elm2 ) ) {
1120 return 0L;
1121 }
1122 elm1 = elm2;
1123 }
1124
1125 /* the list is strictly sorted */
1126 return 2L;
1127 }
1128
IsSSortListObject(Obj obj)1129 static Int IsSSortListObject(Obj obj)
1130 {
1131 return (DoProperty( IsSSortListProp, obj ) == True);
1132 }
1133
FuncIS_SSORT_LIST_DEFAULT(Obj self,Obj obj)1134 static Obj FuncIS_SSORT_LIST_DEFAULT(Obj self, Obj obj)
1135 {
1136 return (IsSSortListDefault( obj ) ? True : False);
1137 }
1138
1139
1140 /****************************************************************************
1141 **
1142 *F IS_POSS_LIST(<list>) . . . . . . . . . . . . . test for positions lists
1143 *V IsPossListFuncs[<type>] . . . . . . table of positions list test function
1144 **
1145 ** 'IS_POSS_LIST' only calls the function pointed to by
1146 ** 'IsPossListFuncs[<type>]', passing <list> as argument. If <type> is not
1147 ** the type of a list, then 'IsPossListFuncs[<type>]' points to
1148 ** 'NotIsPossList', which just returns 0.
1149 */
1150 Int (*IsPossListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
1151
1152 static Obj IsPossListProp;
1153
PropIS_POSS_LIST(Obj self,Obj obj)1154 static Obj PropIS_POSS_LIST(Obj self, Obj obj)
1155 {
1156 return (IS_POSS_LIST(obj) ? True : False);
1157 }
1158
IsPossListDefault(Obj list)1159 static Int IsPossListDefault(Obj list)
1160 {
1161 Int lenList; /* length of <list> */
1162 Obj elm; /* one element of <list> */
1163 Int i; /* loop variable */
1164
1165 /* get the length of the variable */
1166 lenList = LEN_LIST( list );
1167
1168 /* loop over the entries of the list */
1169 for ( i = 1; i <= lenList; i++ ) {
1170 elm = ELMV0_LIST( list, i );
1171
1172 /* if it has a hole then it isn't a poss list */
1173 if ( elm == 0)
1174 return 0L;
1175
1176 /* if it's a small integer and non-positive then
1177 it's not a poss list */
1178 if ( IS_INTOBJ(elm)) {
1179 if (INT_INTOBJ(elm) <= 0)
1180 return 0L;
1181 }
1182 /* or if it's not a small integer or a positive large integer then it's
1183 not a poss list */
1184 else if (TNUM_OBJ(elm) != T_INTPOS)
1185 return 0L;
1186 }
1187
1188 /* the list is a positions list */
1189 return 1L;
1190 }
1191
IsPossListObject(Obj obj)1192 static Int IsPossListObject(Obj obj)
1193 {
1194 return (DoProperty( IsPossListProp, obj ) == True);
1195 }
1196
FuncIS_POSS_LIST_DEFAULT(Obj self,Obj obj)1197 static Obj FuncIS_POSS_LIST_DEFAULT(Obj self, Obj obj)
1198 {
1199 return (IsPossListDefault( obj ) ? True : False);
1200 }
1201
1202
1203 /****************************************************************************
1204 **
1205 *F POS_LIST(<list>,<obj>,<start>) . . . . . . . . find an element in a list
1206 *V PosListFuncs[<type>] . . . . . . . . . . . table of searching functions
1207 *F PosListError(<list>,<obj>,<start>) . . . . . . error searching function
1208 **
1209 ** 'POS_LIST' only calls the function pointed to by 'PosListFuncs[<type>]',
1210 ** passing <list>, <obj>, and <start> as arguments. If <type> is not the
1211 ** type of a list, then 'PosListFuncs[<type>]' points to 'PosListError',
1212 ** which just signals an error.
1213 */
1214 Obj (*PosListFuncs[LAST_REAL_TNUM+1]) ( Obj list, Obj obj, Obj start );
1215
1216 static Obj PosListOper;
1217
PosListHandler2(Obj self,Obj list,Obj obj)1218 static Obj PosListHandler2(Obj self, Obj list, Obj obj)
1219 {
1220 return POS_LIST( list, obj, INTOBJ_INT(0) );
1221 }
1222
PosListHandler3(Obj self,Obj list,Obj obj,Obj start)1223 static Obj PosListHandler3(Obj self, Obj list, Obj obj, Obj start)
1224 {
1225 if (TNUM_OBJ(start) != T_INTPOS && !IS_NONNEG_INTOBJ(start)) {
1226 RequireArgument("Position", start, "must be a non-negative integer");
1227 }
1228 return POS_LIST( list, obj, start );
1229 }
1230
PosListError(Obj list,Obj obj,Obj start)1231 static Obj PosListError(Obj list, Obj obj, Obj start)
1232 {
1233 RequireArgument("Position", list, "must be a list");
1234 }
1235
PosListDefault(Obj list,Obj obj,Obj start)1236 static Obj PosListDefault (
1237 Obj list,
1238 Obj obj,
1239 Obj start )
1240 {
1241 Int lenList;
1242 Obj elm;
1243 Int i;
1244
1245 /* if the starting position is too big to be a small int
1246 then there can't be anything to find */
1247 if (!IS_INTOBJ(start))
1248 return Fail;
1249
1250 /* get the length of the list */
1251 lenList = LEN_LIST( list );
1252
1253 /* loop over all bound entries of the list, and compare against <obj> */
1254 for ( i = INT_INTOBJ(start)+1; i <= lenList; i++ ) {
1255 elm = ELMV0_LIST( list, i );
1256 if ( elm != 0 && EQ( elm, obj ) ) {
1257 break;
1258 }
1259 }
1260
1261 /* return the position if found, and 0 otherwise */
1262 if ( i <= lenList ) {
1263 return INTOBJ_INT(i);
1264 }
1265 else {
1266 return Fail;
1267 }
1268 }
1269
PosListObject(Obj list,Obj obj,Obj start)1270 static Obj PosListObject(Obj list, Obj obj, Obj start)
1271 {
1272 return DoOperation3Args( PosListOper, list, obj, start );
1273 }
1274
FuncPOS_LIST_DEFAULT(Obj self,Obj list,Obj obj,Obj start)1275 static Obj FuncPOS_LIST_DEFAULT(Obj self, Obj list, Obj obj, Obj start)
1276 {
1277 return PosListDefault( list, obj, start ) ;
1278 }
1279
1280
1281 /****************************************************************************
1282 **
1283 *F ElmListLevel(<lists>,<pos>,<level>) . . . . . . . . . . . . . . . . . . .
1284 *F . . . . . . . . . . . . . select an element of several lists in parallel
1285 **
1286 ** 'ElmListLevel' either selects an element from all lists in parallel if
1287 ** <level> is 1, or recurses if <level> is greater than 1.
1288 */
ElmListLevel(Obj lists,Obj ixs,Int level)1289 void ElmListLevel (
1290 Obj lists,
1291 Obj ixs,
1292 Int level )
1293 {
1294 Int len; /* length of <lists> */
1295 Obj list; /* one list from <lists> */
1296 Obj elm; /* selected element from <list> */
1297 Int i; /* loop variable */
1298 Obj pos;
1299 Obj row;
1300 Obj col;
1301
1302
1303 /* if <level> is one, perform the replacements */
1304 if ( level == 1 ) {
1305
1306 /* loop over the elements of <lists> (which must be a plain list) */
1307 len = LEN_PLIST( lists );
1308 for ( i = 1; i <= len; i++ ) {
1309
1310 /* get the list */
1311 list = ELM_PLIST( lists, i );
1312
1313 /* select the element */
1314 switch(LEN_PLIST(ixs)) {
1315 case 1:
1316 pos = ELM_PLIST(ixs,1);
1317 if (IS_INTOBJ(pos))
1318 elm = ELM_LIST( list, INT_INTOBJ(pos) );
1319 else
1320 elm = ELMB_LIST(list, pos);
1321 break;
1322
1323 case 2:
1324 row = ELM_PLIST(ixs, 1);
1325 col = ELM_PLIST(ixs, 2);
1326 elm = ELM_MAT(list, row, col);
1327 break;
1328
1329 default:
1330 elm = ELMB_LIST(list, ixs);
1331
1332 }
1333
1334 /* replace the list with the element */
1335 SET_ELM_PLIST( lists, i, elm );
1336
1337 /* notify Gasman */
1338 CHANGED_BAG( lists );
1339
1340 }
1341 RetypeBag(lists, T_PLIST_DENSE);
1342
1343 }
1344
1345 /* otherwise recurse */
1346 else {
1347
1348 /* loop over the elements of <lists> (which must be a plain list) */
1349 len = LEN_PLIST( lists );
1350 for ( i = 1; i <= len; i++ ) {
1351
1352 /* get the list */
1353 list = ELM_PLIST( lists, i );
1354
1355 /* recurse */
1356 ElmListLevel( list, ixs, level-1 );
1357
1358 }
1359
1360 }
1361
1362 }
1363
1364
1365 /****************************************************************************
1366 **
1367 *F ElmsListLevel(<lists>,<poss>,<level>) . . . . . . . . . . . . . . . . . .
1368 *F . . . . . . . . . . select several elements of several lists in parallel
1369 **
1370 ** 'ElmsListLevel' either selects elements from all lists in parallel if
1371 ** <level> is 1, or recurses if <level> is greater than 1.
1372 */
ElmsListLevel(Obj lists,Obj poss,Int level)1373 void ElmsListLevel (
1374 Obj lists,
1375 Obj poss,
1376 Int level )
1377 {
1378 Int len; /* length of <lists> */
1379 Obj list; /* one list from <lists> */
1380 Obj elm; /* selected elements from <list> */
1381 Int i; /* loop variable */
1382
1383 /* Workaround for issue #312: Accessing a two-level sublist
1384 of a compressed FFE vector could lead to crashes because
1385 FuncELMS_VEC8BIT and FuncELMS_GF2VEC may return lists which are
1386 not plists. This boils down to a conflict between the documented
1387 behavior and requirements of ElmsListLevel and ElmsListFuncs.
1388 Resolving this properly requires some more discussion. But until
1389 then, this change at least prevents hard crashes. */
1390 if (!IS_PLIST(lists)) {
1391 RequireArgument("List Elements", lists, "must be a list");
1392 }
1393
1394 /* if <level> is one, perform the replacements */
1395 if ( level == 1 ) {
1396
1397 /* loop over the elements of <lists> (which must be a plain list) */
1398 len = LEN_PLIST( lists );
1399 for ( i = 1; i <= len; i++ ) {
1400
1401 /* get the list */
1402 list = ELM_PLIST( lists, i );
1403
1404 /* select the elements */
1405 elm = ELMS_LIST( list, poss );
1406
1407 /* replace the list with the elements */
1408 SET_ELM_PLIST( lists, i, elm );
1409
1410 /* notify Gasman */
1411 CHANGED_BAG( lists );
1412
1413 }
1414
1415 /* Since the elements of lists are now mutable lists
1416 (made by ELMS_LIST in the list above), we cannot remember too much
1417 about them */
1418 RetypeBag(lists, T_PLIST_DENSE);
1419
1420 }
1421
1422 /* otherwise recurse */
1423 else {
1424
1425 /* loop over the elements of <lists> (which must be a plain list) */
1426 len = LEN_PLIST( lists );
1427 for ( i = 1; i <= len; i++ ) {
1428
1429 /* get the list */
1430 list = ELM_PLIST( lists, i );
1431
1432 /* recurse */
1433 ElmsListLevel( list, poss, level-1 );
1434
1435 }
1436 RetypeBag(lists, T_PLIST_DENSE);
1437
1438 }
1439
1440 }
1441
1442
1443 /****************************************************************************
1444 **
1445 *F AssListLevel(<lists>,<ixs>,<objs>,<level>) . . . . . . . . . . . . . . .
1446 *F . . . . . . . . . . . . . assign an element to several lists in parallel
1447 **
1448 ** 'AssListLevel' either assigns an element to all lists in parallel if
1449 ** <level> is 1, or recurses if <level> is greater than 1.
1450 */
AssListLevel(Obj lists,Obj ixs,Obj objs,Int level)1451 void AssListLevel (
1452 Obj lists,
1453 Obj ixs,
1454 Obj objs,
1455 Int level )
1456 {
1457 Int len; /* length of <lists> and <objs> */
1458 Obj list; /* one list of <lists> */
1459 Obj obj; /* one value from <objs> */
1460 Int i; /* loop variable */
1461 Obj pos;
1462 Obj row;
1463 Obj col;
1464
1465 /* check <objs> */
1466 RequireDenseList("List Assignments", objs);
1467 RequireSameLength("List Assignments", objs, lists);
1468
1469 /* if <level> is one, perform the assignments */
1470 if ( level == 1 ) {
1471
1472 /* loop over the elements of <lists> (which must be a plain list) */
1473 len = LEN_PLIST( lists );
1474 for ( i = 1; i <= len; i++ ) {
1475
1476 /* get the list */
1477 list = ELM_PLIST( lists, i );
1478
1479 /* select the element to assign */
1480 obj = ELMW_LIST( objs, i );
1481
1482 switch(LEN_PLIST(ixs)) {
1483 case 1:
1484 /* assign the element */
1485 pos = ELM_PLIST(ixs,1);
1486 if (IS_INTOBJ(pos))
1487 ASS_LIST( list, INT_INTOBJ(pos), obj );
1488 else
1489 ASSB_LIST(list, pos, obj);
1490 break;
1491
1492 case 2:
1493 row = ELM_PLIST(ixs, 1);
1494 col = ELM_PLIST(ixs, 2);
1495 ASS_MAT(list, row, col, obj);
1496 break;
1497
1498 default:
1499 ASSB_LIST(list, ixs, obj);
1500 }
1501
1502 }
1503
1504 }
1505
1506 /* otherwise recurse */
1507 else {
1508
1509 /* loop over the elements of <lists> (which must be a plain list) */
1510 len = LEN_PLIST( lists );
1511 for ( i = 1; i <= len; i++ ) {
1512
1513 /* get the list */
1514 list = ELM_PLIST( lists, i );
1515
1516 /* get the values */
1517 obj = ELMW_LIST( objs, i );
1518
1519 /* recurse */
1520 AssListLevel( list, ixs, obj, level-1 );
1521
1522 }
1523
1524 }
1525
1526 }
1527
1528
1529 /****************************************************************************
1530 **
1531 *F AsssListLevel(<lists>,<poss>,<objs>,<level>) . . . . . . . . . . . . . .
1532 *F . . . . . . . . . . assign several elements to several lists in parallel
1533 **
1534 ** 'AsssListLevel' either assigns elements to all lists in parallel if
1535 ** <level> is 1, or recurses if <level> is greater than 1.
1536 */
AsssListLevel(Obj lists,Obj poss,Obj objs,Int lev)1537 void AsssListLevel (
1538 Obj lists,
1539 Obj poss,
1540 Obj objs,
1541 Int lev )
1542 {
1543 Int len; /* length of <lists> and <objs> */
1544 Obj list; /* one list of <lists> */
1545 Obj obj; /* one value from <objs> */
1546 Int i; /* loop variable */
1547
1548 /* check <objs> */
1549 RequireDenseList("List Assignments", objs);
1550 RequireSameLength("List Assignments", objs, lists);
1551
1552 /* if <lev> is one, loop over all the lists and assign the value */
1553 if ( lev == 1 ) {
1554
1555 /* loop over the list entries (which must be lists too) */
1556 len = LEN_PLIST( lists );
1557 for ( i = 1; i <= len; i++ ) {
1558
1559 /* get the list */
1560 list = ELM_PLIST( lists, i );
1561
1562 /* select the elements to assign */
1563 obj = ELMW_LIST( objs, i );
1564 CheckIsDenseList("List Assignments", "objs", obj);
1565 CheckSameLength("List Assignments", "objs", "poss", obj, poss);
1566
1567 /* assign the elements */
1568 ASSS_LIST( list, poss, obj );
1569
1570 }
1571
1572 }
1573
1574 /* otherwise recurse */
1575 else {
1576
1577 /* loop over the list entries (which must be lists too) */
1578 len = LEN_PLIST( lists );
1579 for ( i = 1; i <= len; i++ ) {
1580
1581 /* get the list */
1582 list = ELM_PLIST( lists, i );
1583
1584 /* get the values */
1585 obj = ELMW_LIST( objs, i );
1586
1587 /* recurse */
1588 AsssListLevel( list, poss, obj, lev-1 );
1589
1590 }
1591
1592 }
1593
1594 }
1595
1596
1597 /****************************************************************************
1598 **
1599 *F PLAIN_LIST(<list>) . . . . . . . . . . . convert a list to a plain list
1600 *V PlainListFuncs[<type>] . . . . . . . . . . table of conversion functions
1601 *F PlainListError(<list>) . . . . . . . . . . . . error conversion function
1602 **
1603 ** 'PLAIN_LIST' only calls the function pointed to by
1604 ** 'PlainListFuncs[<type>]', passing <list> as argument. If <type> is not
1605 ** the type of a list, then 'PlainListFuncs[<type>]' points to
1606 ** 'PlainListError', which just signals an error.
1607 */
1608 void (*PlainListFuncs[LAST_REAL_TNUM+1]) ( Obj list );
1609
PlainListError(Obj list)1610 static void PlainListError(Obj list)
1611 {
1612 ErrorQuit(
1613 "Panic: cannot convert <list> (is a %s) to a plain list",
1614 (Int)TNAM_OBJ(list), 0L );
1615 }
1616
1617
1618 /****************************************************************************
1619 **
1620 *F TYPES_LIST_FAM(<fam>) . . . . . . . list of types of lists over a family
1621 */
1622 static UInt TYPES_LIST_FAM_RNam;
1623
TYPES_LIST_FAM(Obj fam)1624 Obj TYPES_LIST_FAM (
1625 Obj fam )
1626 {
1627 #ifdef HPCGAP
1628 switch (TNUM_OBJ(fam))
1629 {
1630 case T_COMOBJ:
1631 return ElmPRec( fam, TYPES_LIST_FAM_RNam );
1632 case T_ACOMOBJ:
1633 MEMBAR_READ();
1634 return GetARecordField( fam, TYPES_LIST_FAM_RNam );
1635 default:
1636 return 0;
1637 }
1638 #else
1639 return ElmPRec( fam, TYPES_LIST_FAM_RNam );
1640 #endif
1641 }
1642
1643
1644 /****************************************************************************
1645 **
1646 *F PrintListDefault(<list>) . . . . . . . . . . . . . . . . . print a list
1647 *F PrintPathList(<list>,<indx>) . . . . . . . . . . . . . print a list path
1648 **
1649 ** 'PrintListDefault' simply prints the elements in the given list.
1650 ** The line break hints are consistent with those
1651 ** that appear in the 'ViewObj' and 'ViewString' methods for finite lists.
1652 */
PrintListDefault(Obj list)1653 static void PrintListDefault(Obj list)
1654 {
1655 Obj elm;
1656
1657 if ( 0 < LEN_LIST(list) && IsStringConv(list) ) {
1658 PrintString(list);
1659 return;
1660 }
1661
1662 Pr("%2>[ %2>",0L,0L);
1663 for (UInt i = 1; i <= LEN_LIST(list); i++) {
1664 elm = ELMV0_LIST(list, i);
1665 if ( elm != 0 ) {
1666 if (1 < i)
1667 Pr("%<,%< %2>", 0L, 0L);
1668 SetPrintObjIndex(i);
1669 PrintObj( elm );
1670 }
1671 else {
1672 if (1 < i)
1673 Pr("%2<,%2>", 0L, 0L);
1674 }
1675 }
1676 Pr(" %4<]",0L,0L);
1677 }
1678
PrintPathList(Obj list,Int indx)1679 static void PrintPathList(Obj list, Int indx)
1680 {
1681 Pr( "[%d]", indx, 0L );
1682 }
1683
1684
1685 /****************************************************************************
1686 **
1687 *V SetFiltListTNums[ <tnum> ][ <fnum> ] . . . . . new tnum after filter set
1688 **
1689 ** If a list with type number <tnum> gains the filter with filter number
1690 ** <fnum>, then the new type number is stored in:
1691 **
1692 ** `SetFiltListTNums[<tnum>][<fnum>]'
1693 **
1694 ** The macro `SET_FILT_LIST' is used to set the filter for a list by
1695 ** changing its type number.
1696 */
1697 UInt SetFiltListTNums [ LAST_REAL_TNUM ] [ LAST_FN + 1 ];
1698
1699
1700 /****************************************************************************
1701 **
1702 *V ResetFiltListTNums[ <tnum> ][ <fnum> ] . . . new tnum after filter reset
1703 **
1704 ** If a list with type number <tnum> loses the filter with filter number
1705 ** <fnum>, then the new type number is stored in:
1706 **
1707 ** `ResetFiltListTNums[<tnum>][<fnum>]'
1708 **
1709 ** The macro `RESET_FILT_LIST' is used to set the filter for a list by
1710 ** changing its type number.
1711 */
1712 UInt ResetFiltListTNums [ LAST_REAL_TNUM ] [ LAST_FN + 1];
1713
1714
1715 /****************************************************************************
1716 **
1717 *V HasFiltListTNums[ <tnum> ][ <fnum> ] . . . . . . . . . . . . has filter
1718 */
1719 Int HasFiltListTNums [ LAST_REAL_TNUM ] [ LAST_FN + 1 ];
1720
1721
1722 /****************************************************************************
1723 **
1724 *V ClearFiltsTNums[ <tnum> ] . . . . . . . . . . . . clear all list filters
1725 **
1726 ** The type number without any known properties of a list of type number
1727 ** <tnum> is stored in:
1728 **
1729 ** `ClearPropsTNums[<tnum>]'
1730 **
1731 ** The macro `CLEAR_PROPS_LIST' is used to clear all properties of a list.
1732 */
1733 UInt ClearFiltsTNums [ LAST_REAL_TNUM ];
1734
1735
1736 /****************************************************************************
1737 **
1738 *F SET_FILTER_LIST( <list>, <filter> ) . . . . . . . . . . . . . set filter
1739 */
SET_FILTER_LIST(Obj list,Obj filter)1740 Obj SET_FILTER_LIST(Obj list, Obj filter)
1741 {
1742 Int new;
1743 Obj flags;
1744
1745 flags = FLAGS_FILT(filter);
1746 if (FuncIS_SUBSET_FLAGS(0,flags,FLAGS_FILT(IsSSortListProp))==True) {
1747 new = SetFiltListTNums[TNUM_OBJ(list)][FN_IS_DENSE];
1748 if ( new < 0 ) goto error;
1749 new = SetFiltListTNums[TNUM_OBJ(list)][FN_IS_SSORT];
1750 if ( new > 0 ) RetypeBag( list, new ); else goto error;
1751 }
1752 return 0;
1753
1754 /* setting of filter failed */
1755 error:
1756 ErrorMayQuit("filter not possible for %s", (Int)TNAM_OBJ(list), 0);
1757 return 0;
1758 }
1759
1760
1761 /****************************************************************************
1762 **
1763 *F * * * * * * * * * * * functions with checking * * * * * * * * * * * * * *
1764 */
1765
1766
1767 /****************************************************************************
1768 **
1769 *F AsssListCheck( <list>, <poss>, <rhss> ) . . . . . . . . . . . . ASSS_LIST
1770 */
AsssListCheck(Obj list,Obj poss,Obj rhss)1771 void AsssListCheck (
1772 Obj list,
1773 Obj poss,
1774 Obj rhss )
1775 {
1776 CheckIsPossList("List Assignments", poss);
1777 RequireDenseList("List Assignments", rhss);
1778 RequireSameLength("List Assignments", rhss, poss);
1779 ASSS_LIST( list, poss, rhss );
1780 }
1781
1782
1783 /****************************************************************************
1784 **
1785 *F AsssListLevelCheck( <lists>, <poss>, <rhss>, <level> ) . . AsssListLevel
1786 */
AsssListLevelCheck(Obj lists,Obj poss,Obj rhss,Int level)1787 void AsssListLevelCheck (
1788 Obj lists,
1789 Obj poss,
1790 Obj rhss,
1791 Int level )
1792 {
1793 CheckIsPossList("List Assignments", poss);
1794 AsssListLevel( lists, poss, rhss, level );
1795 }
1796
1797
1798 /****************************************************************************
1799 **
1800 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
1801 */
1802
1803
1804 /****************************************************************************
1805 **
1806 *V GVarFilts . . . . . . . . . . . . . . . . . . . list of filters to export
1807 */
1808 static StructGVarFilt GVarFilts [] = {
1809
1810 GVAR_FILT(IS_LIST, "obj", &IsListFilt),
1811 GVAR_FILT(IS_DENSE_LIST, "obj", &IsDenseListFilt),
1812 GVAR_FILT(IS_HOMOG_LIST, "obj", &IsHomogListFilt),
1813 GVAR_FILT(IS_TABLE_LIST, "obj", &IsTableListFilt),
1814 { 0, 0, 0, 0, 0 }
1815
1816 };
1817
1818
1819 /****************************************************************************
1820 **
1821 *V GVarAttrs . . . . . . . . . . . . . . . . . list of attributes to export
1822 */
1823 static StructGVarAttr GVarAttrs [] = {
1824
1825 GVAR_ATTR(LENGTH, "list", &LengthAttr),
1826 { 0, 0, 0, 0, 0 }
1827
1828 };
1829
1830
1831 /****************************************************************************
1832 **
1833 *V GVarProps . . . . . . . . . . . . . . . . . list of properties to export
1834 */
1835 static StructGVarProp GVarProps [] = {
1836
1837 GVAR_PROP(IS_SSORT_LIST, "obj", &IsSSortListProp),
1838 GVAR_PROP(IS_POSS_LIST, "obj", &IsPossListProp),
1839 { 0, 0, 0, 0, 0 }
1840
1841 };
1842
1843
1844 /****************************************************************************
1845 **
1846 *V GVarOpers . . . . . . . . . . . . . . . . . list of operations to export
1847 */
1848 static StructGVarOper GVarOpers[] = {
1849
1850 // POS_LIST can take 2 or 3 arguments; since NewOperation ignores the
1851 // handler for variadic operations, use DoOperation0Args as a placeholder.
1852 { "POS_LIST", -1, "list, obj[, start]", &PosListOper, DoOperation0Args,
1853 "src/lists.c:POS_LIST" },
1854
1855 GVAR_OPER(ISB_LIST, 2, "list, pos", &IsbListOper),
1856 GVAR_OPER(ELM0_LIST, 2, "list, pos", &Elm0ListOper),
1857 GVAR_OPER(ELM_DEFAULT_LIST, 3, "list, pos, default", &ElmDefListOper),
1858 GVAR_OPER(ELM_LIST, 2, "list, pos", &ElmListOper),
1859 GVAR_OPER(ELMS_LIST, 2, "list, poss", &ElmsListOper),
1860 GVAR_OPER(UNB_LIST, 2, "list, pos", &UnbListOper),
1861 GVAR_OPER(ASS_LIST, 3, "list, pos, obj", &AssListOper),
1862 GVAR_OPER(ASSS_LIST, 3, "list, poss, objs", &AsssListOper),
1863
1864 GVAR_OPER(ASS_MAT, 4, "mat, row, col, obj", &AssMatOper),
1865 GVAR_OPER(ELM_MAT, 3, "mat, row, col", &ElmMatOper),
1866
1867 { 0, 0, 0, 0, 0, 0 }
1868
1869 };
1870
1871
1872 /****************************************************************************
1873 **
1874 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1875 */
1876 static StructGVarFunc GVarFuncs [] = {
1877
1878 GVAR_FUNC(LEN_LIST, 1, "list"),
1879 GVAR_FUNC(ELMS_LIST_DEFAULT, 2, "list, poss"),
1880 GVAR_FUNC(ASSS_LIST_DEFAULT, 3, "list, poss, objs"),
1881 GVAR_FUNC(IS_SSORT_LIST_DEFAULT, 1, "list"),
1882 GVAR_FUNC(IS_POSS_LIST_DEFAULT, 1, "list"),
1883 GVAR_FUNC(POS_LIST_DEFAULT, 3, "list, obj, start"),
1884 { 0, 0, 0, 0, 0 }
1885
1886 };
1887
1888
1889 /****************************************************************************
1890 **
1891 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1892 */
InitKernel(StructInitInfo * module)1893 static Int InitKernel (
1894 StructInitInfo * module )
1895 {
1896 UInt type; /* loop variable */
1897 Int i; /* loop variable */
1898
1899 /* make and install the 'POS_LIST' operation */
1900 InitHandlerFunc( PosListHandler2, "src/lists.c:PosListHandler2" );
1901 InitHandlerFunc( PosListHandler3, "src/lists.c:PosListHandler3" );
1902
1903 /* init filters and functions */
1904 InitHdlrFiltsFromTable( GVarFilts );
1905 InitHdlrAttrsFromTable( GVarAttrs );
1906 InitHdlrPropsFromTable( GVarProps );
1907 InitHdlrOpersFromTable( GVarOpers );
1908 InitHdlrFuncsFromTable( GVarFuncs );
1909
1910 /* import small list machinery from the library */
1911 ImportFuncFromLibrary("IsSmallList", &IsSmallListFilt);
1912 ImportFuncFromLibrary("HasIsSmallList", &HasIsSmallListFilt);
1913 ImportFuncFromLibrary("SetIsSmallList", &SetIsSmallList);
1914
1915 /* make and install the 'IS_LIST' filter */
1916 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1917 assert(IsListFuncs[ type ] == 0);
1918 IsListFuncs[ type ] = AlwaysNo;
1919 }
1920 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
1921 IsListFuncs[ type ] = AlwaysYes;
1922 }
1923 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
1924 IsListFuncs[ type ] = IsListObject;
1925 }
1926
1927 /* make and install the 'IS_SMALL_LIST' filter */
1928 /* non-lists are not small lists */
1929 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1930 assert(IsSmallListFuncs[ type ] == 0);
1931 IsSmallListFuncs[ type ] = AlwaysNo;
1932 }
1933 /* internal lists ARE small lists */
1934 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
1935 IsSmallListFuncs[ type ] = AlwaysYes;
1936 }
1937 /* external lists need to be asked */
1938 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
1939 IsSmallListFuncs[ type ] = IsSmallListObject;
1940 }
1941
1942
1943 /* make and install the 'LEN_LIST' function */
1944 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1945 assert(LenListFuncs[ type ] == 0);
1946 LenListFuncs[ type ] = LenListError;
1947 }
1948 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
1949 LenListFuncs[ type ] = LenListObject;
1950 }
1951
1952 /* make and install the 'LENGTH' function */
1953 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1954 assert(LengthFuncs[ type ] == 0);
1955 LengthFuncs[ type ] = LengthError;
1956 }
1957 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
1958 LengthFuncs[ type ] = LengthObject;
1959 }
1960 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
1961 LengthFuncs[ type ] = LengthInternal;
1962 }
1963
1964
1965 /* make and install the 'ISB_LIST' operation */
1966 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1967 IsbListFuncs[ type ] = IsbListError;
1968 }
1969 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
1970 IsbListFuncs[ type ] = IsbListObject;
1971 }
1972
1973 /* make and install the 'ELM0_LIST' operation */
1974 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1975 assert(Elm0ListFuncs[ type ] == 0);
1976 Elm0ListFuncs[ type ] = Elm0ListError;
1977 assert(Elm0vListFuncs[ type ] == 0);
1978 Elm0vListFuncs[ type ] = Elm0ListError;
1979 }
1980 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
1981 Elm0ListFuncs[ type ] = Elm0ListObject;
1982 Elm0vListFuncs[ type ] = Elm0ListObject;
1983 }
1984
1985 // make and install ELM_DEFAULT_LIST operation
1986 // we install this for all TNUMs, as the default implementation delegates
1987 // to other list operations, we can error if approriate
1988 for (type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++) {
1989 ElmDefListFuncs[type] = ElmDefListDefault;
1990 }
1991 for (type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++) {
1992 ElmDefListFuncs[type] = ElmDefListObject;
1993 }
1994
1995
1996 /* make and install the 'ELM_LIST' operation */
1997 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
1998 assert(ElmListFuncs[ type ] == 0);
1999 ElmListFuncs[ type ] = ElmListError;
2000 assert(ElmvListFuncs[ type ] == 0);
2001 ElmvListFuncs[ type ] = ElmListError;
2002 assert(ElmwListFuncs[ type ] == 0);
2003 ElmwListFuncs[ type ] = ElmListError;
2004 }
2005 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2006 ElmListFuncs[ type ] = ElmListObject;
2007 ElmvListFuncs[ type ] = ElmListObject;
2008 ElmwListFuncs[ type ] = ElmListObject;
2009 }
2010
2011
2012 /* make and install the 'ELMS_LIST' operation */
2013 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2014 assert(ElmsListFuncs[ type ] == 0);
2015 ElmsListFuncs[ type ] = ElmsListError;
2016 }
2017 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2018 ElmsListFuncs[ type ] = ElmsListDefault;
2019 }
2020 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2021 ElmsListFuncs[ type ] = ElmsListObject;
2022 }
2023
2024
2025 /* make and install the 'UNB_LIST' operation */
2026 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2027 assert(UnbListFuncs[ type ] == 0);
2028 UnbListFuncs[ type ] = UnbListError;
2029 }
2030 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2031 UnbListFuncs[ type ] = 0;
2032 }
2033 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2034 UnbListFuncs[ type ] = UnbListObject;
2035 }
2036
2037
2038 /* make and install the 'ASS_LIST' operation */
2039 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2040 assert(AssListFuncs[ type ] == 0);
2041 AssListFuncs[ type ] = AssListError;
2042 }
2043 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2044 AssListFuncs[ type ] = 0;
2045 }
2046 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2047 AssListFuncs[ type ] = AssListObject;
2048 }
2049
2050
2051 /* make and install the 'ASSS_LIST' operation */
2052 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2053 assert(AsssListFuncs[ type ] == 0);
2054 AsssListFuncs[ type ] = AsssListError;
2055 }
2056 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2057 AsssListFuncs[ type ] = AsssListDefault;
2058 }
2059 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2060 AsssListFuncs[ type ] = AsssListObject;
2061 }
2062
2063
2064 /* make and install the 'IS_DENSE_LIST' filter */
2065 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2066 assert(IsDenseListFuncs[ type ] == 0);
2067 IsDenseListFuncs[ type ] = AlwaysNo;
2068 }
2069 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2070 IsDenseListFuncs[ type ] = 0;
2071 }
2072 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2073 IsDenseListFuncs[ type ] = IsDenseListObject;
2074 }
2075
2076
2077 /* make and install the 'IS_HOMOG_LIST' filter */
2078 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2079 assert(IsHomogListFuncs[ type ] == 0);
2080 IsHomogListFuncs[ type ] = AlwaysNo;
2081 }
2082 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2083 IsHomogListFuncs[ type ] = 0;
2084 }
2085 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2086 IsHomogListFuncs[ type ] = IsHomogListObject;
2087 }
2088
2089
2090 /* make and install the 'IS_TABLE_LIST' filter */
2091 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2092 assert(IsTableListFuncs[ type ] == 0);
2093 IsTableListFuncs[ type ] = AlwaysNo;
2094 }
2095 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2096 IsTableListFuncs[ type ] = 0;
2097 }
2098 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2099 IsTableListFuncs[ type ] = IsTableListObject;
2100 }
2101
2102
2103 /* make and install the 'IS_SSORT_LIST' property */
2104 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2105 assert(IsSSortListFuncs[ type ] == 0);
2106 IsSSortListFuncs[ type ] = AlwaysNo;
2107 }
2108 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2109 IsSSortListFuncs[ type ] = 0;
2110 }
2111 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2112 IsSSortListFuncs[ type ] = IsSSortListObject;
2113 }
2114
2115
2116 /* make and install the 'IS_POSS_LIST' property */
2117 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2118 assert(IsPossListFuncs[ type ] == 0);
2119 IsPossListFuncs[ type ] = AlwaysNo;
2120 }
2121 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2122 IsPossListFuncs[ type ] = 0;
2123 }
2124 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2125 IsPossListFuncs[ type ] = IsPossListObject;
2126 }
2127
2128
2129 /* make and install the 'POS_LIST' operation */
2130 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2131 assert(PosListFuncs[ type ] == 0);
2132 PosListFuncs[ type ] = PosListError;
2133 }
2134 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2135 PosListFuncs[ type ] = 0;
2136 }
2137 for ( type = FIRST_EXTERNAL_TNUM; type <= LAST_EXTERNAL_TNUM; type++ ) {
2138 PosListFuncs[ type ] = PosListObject;
2139 }
2140
2141
2142 /* install the error functions into the other tables */
2143 for ( type = FIRST_REAL_TNUM; type <= LAST_REAL_TNUM; type++ ) {
2144 assert(PlainListFuncs [ type ] == 0);
2145 PlainListFuncs [ type ] = PlainListError;
2146 }
2147
2148
2149 /* install tests for being copyable */
2150 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type += 2 ) {
2151 IsCopyableObjFuncs[ type ] = AlwaysYes;
2152 IsCopyableObjFuncs[ type+IMMUTABLE ] = AlwaysYes;
2153 }
2154
2155 /* install the default printers */
2156 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type++ ) {
2157 PrintObjFuncs [ type ] = PrintListDefault;
2158 PrintPathFuncs[ type ] = PrintPathList;
2159 }
2160
2161
2162 /* initialise filter table */
2163 for ( type = FIRST_LIST_TNUM; type <= LAST_LIST_TNUM; type +=2 ) {
2164 ClearFiltsTNums [ type ] = 0;
2165 ClearFiltsTNums [ type +IMMUTABLE ] = 0;
2166 for ( i = 0; i <= LAST_FN; i++ ) {
2167 SetFiltListTNums [ type ][i] = 0;
2168 SetFiltListTNums [ type +IMMUTABLE ][i] = 0;
2169 ResetFiltListTNums[ type ][i] = 0;
2170 ResetFiltListTNums[ type +IMMUTABLE ][i] = 0;
2171 HasFiltListTNums [ type ][i] = -1;
2172 HasFiltListTNums [ type +IMMUTABLE ][i] = -1;
2173 }
2174 }
2175
2176 /* return success */
2177 return 0;
2178 }
2179
2180
2181 /****************************************************************************
2182 **
2183 *F PostRestore( <module> ) . . . . . . . . . . . . . after restore workspace
2184 */
PostRestore(StructInitInfo * module)2185 static Int PostRestore (
2186 StructInitInfo * module )
2187 {
2188 /* whats that? */
2189 TYPES_LIST_FAM_RNam = RNamName( "TYPES_LIST_FAM" );
2190
2191 /* return success */
2192 return 0;
2193 }
2194
2195
2196 /****************************************************************************
2197 **
2198 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
2199 */
InitLibrary(StructInitInfo * module)2200 static Int InitLibrary (
2201 StructInitInfo * module )
2202 {
2203 /* init filters and functions */
2204 InitGVarFiltsFromTable( GVarFilts );
2205 InitGVarAttrsFromTable( GVarAttrs );
2206 InitGVarPropsFromTable( GVarProps );
2207 InitGVarOpersFromTable( GVarOpers );
2208 InitGVarFuncsFromTable( GVarFuncs );
2209
2210 /* make and install the 'POS_LIST' operation */
2211 SET_HDLR_FUNC( PosListOper, 2, PosListHandler2 );
2212 SET_HDLR_FUNC( PosListOper, 3, PosListHandler3 );
2213
2214 /* return success */
2215 return PostRestore( module );
2216 }
2217
2218
2219 /****************************************************************************
2220 **
2221 *F CheckInit( <module> ) . . . . . . . . . . . . . . . check initialisation
2222 */
CheckInit(StructInitInfo * module)2223 static Int CheckInit (
2224 StructInitInfo * module )
2225 {
2226 Int i; /* loop variable */
2227 Int j; /* loop variable */
2228 Int success = 1;
2229
2230 Int fnums[] = { FN_IS_DENSE, FN_IS_NDENSE,
2231 FN_IS_HOMOG, FN_IS_NHOMOG,
2232 FN_IS_TABLE,
2233 FN_IS_SSORT, FN_IS_NSORT };
2234 const Char *fnams[] = { "dense", "ndense",
2235 "homog", "nhomog",
2236 "table",
2237 "ssort", "nsort" };
2238
2239
2240 /* fix unknown list types */
2241 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i +=2 ) {
2242 GAP_ASSERT( TNAM_TNUM(i) );
2243 GAP_ASSERT( TNAM_TNUM(i + IMMUTABLE) );
2244 }
2245
2246 for (i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i += 2) {
2247 GAP_ASSERT(UnbListFuncs[i]);
2248 GAP_ASSERT(AssListFuncs[i]);
2249 }
2250 for (i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++) {
2251 GAP_ASSERT(IsDenseListFuncs[i]);
2252 GAP_ASSERT(IsHomogListFuncs[i]);
2253 GAP_ASSERT(IsTableListFuncs[i]);
2254 GAP_ASSERT(IsSSortListFuncs[i]);
2255 GAP_ASSERT(IsPossListFuncs[i]);
2256 GAP_ASSERT(PosListFuncs[i]);
2257 GAP_ASSERT(IsSSortListFuncs[i]);
2258 GAP_ASSERT(IsSSortListFuncs[i]);
2259 }
2260
2261 /* check that all relevant `ClearFiltListTNums' are installed */
2262 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2263 if ( ClearFiltsTNums[i] == 0 ) {
2264 Pr( "#W ClearFiltsListTNums [%s] missing\n",
2265 (Int)TNAM_TNUM(i), 0L );
2266 success = 0;
2267 }
2268 }
2269
2270
2271 /* check that all relevant `HasFiltListTNums' are installed */
2272 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2273 for ( j = 0; j < ARRAY_SIZE(fnums); j++ ) {
2274 if ( HasFiltListTNums[i][fnums[j]] == -1 ) {
2275 Pr( "#W HasFiltListTNums [%s] [%s] missing\n",
2276 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2277 success = 0;
2278 HasFiltListTNums[i][fnums[j]] = 0;
2279 }
2280 }
2281 }
2282
2283
2284 /* check that all relevant `SetFiltListTNums' are installed */
2285 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2286 for ( j = 0; j < ARRAY_SIZE(fnums); j++ ) {
2287 if ( SetFiltListTNums[i][fnums[j]] == 0 ) {
2288 Pr( "#W SetFiltListTNums [%s] [%s] missing\n",
2289 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2290 success = 0;
2291 }
2292 }
2293 }
2294
2295
2296 /* check that all relevant `ResetFiltListTNums' are installed */
2297 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2298 for ( j = 0; j < ARRAY_SIZE(fnums); j++ ) {
2299 if ( ResetFiltListTNums[i][fnums[j]] == 0 ) {
2300 Pr( "#W ResetFiltListTNums [%s] [%s] missing\n",
2301 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2302 success = 0;
2303 }
2304 }
2305 }
2306
2307 /* if a tnum has a filter, reset must change the tnum */
2308 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2309 for ( j = 0; j < ARRAY_SIZE(fnums); j++ ) {
2310 if ( HasFiltListTNums[i][fnums[j]] ) {
2311 Int new;
2312 new = ResetFiltListTNums[i][fnums[j]];
2313 if ( new == i ) {
2314 continue; /* filter coded into the representation */
2315
2316 }
2317 else if ( new != -1 && HasFiltListTNums[new][fnums[j]] ) {
2318 Pr(
2319 "#W ResetFiltListTNums [%s] [%s] failed to reset\n",
2320 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2321 success = 0;
2322 }
2323 }
2324 }
2325 }
2326
2327 /* if a tnum has a filter, set must not change the tnum */
2328 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2329 for ( j = 0; j < ARRAY_SIZE(fnums); j++ ) {
2330 if ( HasFiltListTNums[i][fnums[j]] ) {
2331 Int new;
2332 new = SetFiltListTNums[i][fnums[j]];
2333 if ( new != -1 && new != i ) {
2334 Pr(
2335 "#W SetFiltListTNums [%s] [%s] must not change\n",
2336 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2337 success = 0;
2338 }
2339 }
2340 }
2341 }
2342
2343 /* check implications */
2344 for ( i = FIRST_LIST_TNUM; i <= LAST_LIST_TNUM; i++ ) {
2345
2346 if ( (i & IMMUTABLE) == 0 ) {
2347 if ( ClearFiltsTNums[i]+IMMUTABLE != ClearFiltsTNums[i+IMMUTABLE]) {
2348 Pr( "#W ClearFiltsTNums [%s] mismatch between mutable and immutable\n",
2349 (Int)TNAM_TNUM(i), 0 );
2350 success = 0;
2351 }
2352 for ( j = 0; j < ARRAY_SIZE(fnums); j++ ) {
2353
2354 if ( HasFiltListTNums[i][fnums[j]] !=
2355 HasFiltListTNums[i+IMMUTABLE][fnums[j]]) {
2356 Pr( "#W HasFiltListTNums [%s] [%s] mismatch between mutable and immutable\n",
2357 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2358 success = 0;
2359 }
2360
2361 if ( (SetFiltListTNums[i][fnums[j]] | IMMUTABLE) !=
2362 SetFiltListTNums[i+IMMUTABLE][fnums[j]]) {
2363 Pr( "#W SetFiltListTNums [%s] [%s] mismatch between mutable and immutable\n",
2364 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2365 success = 0;
2366 }
2367
2368 if ( (ResetFiltListTNums[i][fnums[j]] | IMMUTABLE) !=
2369 ResetFiltListTNums[i+IMMUTABLE][fnums[j]]) {
2370 Pr( "#W ResetFiltListTNums [%s] [%s] mismatch between mutable and immutable\n",
2371 (Int)TNAM_TNUM(i), (Int)fnams[j] );
2372 success = 0;
2373 }
2374
2375 }
2376 }
2377
2378 if ( i == T_PLIST_EMPTY || i == T_PLIST_EMPTY+IMMUTABLE ) {
2379 if ( ! HasFiltListTNums[i][FN_IS_DENSE] ) {
2380 Pr(
2381 "#W HasFiltListTNums [%s] [ empty -> dense ] missing\n",
2382 (Int)TNAM_TNUM(i), 0L );
2383 success = 0;
2384 }
2385 if ( HasFiltListTNums[i][FN_IS_NDENSE] ) {
2386 Pr(
2387 "#W HasFiltListTNums [%s] [ empty + ndense ] illegal\n",
2388 (Int)TNAM_TNUM(i), 0L );
2389 success = 0;
2390 }
2391 if ( ! HasFiltListTNums[i][FN_IS_HOMOG] ) {
2392 Pr(
2393 "#W HasFiltListTNums [%s] [ empty -> homog ] missing\n",
2394 (Int)TNAM_TNUM(i), 0L );
2395 success = 0;
2396 }
2397 if ( HasFiltListTNums[i][FN_IS_NHOMOG] ) {
2398 Pr(
2399 "#W HasFiltListTNums [%s] [ empty + nhomog ] illegal\n",
2400 (Int)TNAM_TNUM(i), 0L );
2401 success = 0;
2402 }
2403 if ( ! HasFiltListTNums[i][FN_IS_SSORT] ) {
2404 Pr(
2405 "#W HasFiltListTNums [%s] [ empty -> ssort ] missing\n",
2406 (Int)TNAM_TNUM(i), 0L );
2407 success = 0;
2408 }
2409 if ( HasFiltListTNums[i][FN_IS_NSORT] ) {
2410 Pr(
2411 "#W HasFiltListTNums [%s] [ empty + nsort ] illegal\n",
2412 (Int)TNAM_TNUM(i), 0L );
2413 success = 0;
2414 }
2415 if ( HasFiltListTNums[i][FN_IS_TABLE] ) {
2416 Pr(
2417 "#W HasFiltListTNums [%s] [ empty + table ] illegal\n",
2418 (Int)TNAM_TNUM(i), 0L );
2419 success = 0;
2420 }
2421 }
2422
2423 if ( HasFiltListTNums[i][FN_IS_DENSE] ) {
2424 if ( HasFiltListTNums[i][FN_IS_NDENSE] ) {
2425 Pr(
2426 "#W HasFiltListTNums [%s] [ dense + ndense ] illegal\n",
2427 (Int)TNAM_TNUM(i), 0L );
2428 success = 0;
2429 }
2430 }
2431
2432 if ( HasFiltListTNums[i][FN_IS_NDENSE] ) {
2433 if ( HasFiltListTNums[i][FN_IS_HOMOG] ) {
2434 Pr(
2435 "#W HasFiltListTNums [%s] [ ndense + homog ] illegal\n",
2436 (Int)TNAM_TNUM(i), 0L );
2437 success = 0;
2438 }
2439 if ( HasFiltListTNums[i][FN_IS_TABLE] ) {
2440 Pr(
2441 "#W HasFiltListTNums [%s] [ ndense + table ] illegal\n",
2442 (Int)TNAM_TNUM(i), 0L );
2443 success = 0;
2444 }
2445 }
2446
2447 if ( HasFiltListTNums[i][FN_IS_HOMOG] ) {
2448 if ( HasFiltListTNums[i][FN_IS_NHOMOG] ) {
2449 Pr(
2450 "#W HasFiltListTNums [%s] [ homog + nhomog ] illegal\n",
2451 (Int)TNAM_TNUM(i), 0L );
2452 success = 0;
2453 }
2454 if ( ! HasFiltListTNums[i][FN_IS_DENSE] ) {
2455 Pr(
2456 "#W HasFiltListTNums [%s] [ homog -> dense ] missing\n",
2457 (Int)TNAM_TNUM(i), 0L );
2458 success = 0;
2459 }
2460 if ( HasFiltListTNums[i][FN_IS_NDENSE] ) {
2461 Pr(
2462 "#W HasFiltListTNums [%s] [ homog + ndense ] illegal\n",
2463 (Int)TNAM_TNUM(i), 0L );
2464 success = 0;
2465 }
2466 }
2467
2468 if ( HasFiltListTNums[i][FN_IS_NHOMOG] ) {
2469 if ( HasFiltListTNums[i][FN_IS_TABLE] ) {
2470 Pr(
2471 "#W HasFiltListTNums [%s] [ nhomog + table ] illegal\n",
2472 (Int)TNAM_TNUM(i), 0L );
2473 success = 0;
2474 }
2475 }
2476
2477 if ( HasFiltListTNums[i][FN_IS_TABLE] ) {
2478 if ( ! HasFiltListTNums[i][FN_IS_HOMOG] ) {
2479 Pr(
2480 "#W HasFiltListTNums [%s] [ table -> homog ] missing\n",
2481 (Int)TNAM_TNUM(i), 0L );
2482 success = 0;
2483 }
2484 if ( ! HasFiltListTNums[i][FN_IS_DENSE] ) {
2485 Pr(
2486 "#W HasFiltListTNums [%s] [ table -> dense ] missing\n",
2487 (Int)TNAM_TNUM(i), 0L );
2488 success = 0;
2489 }
2490 }
2491
2492 if ( HasFiltListTNums[i][FN_IS_SSORT] ) {
2493 if ( HasFiltListTNums[i][FN_IS_NSORT] ) {
2494 Pr(
2495 "#W HasFiltListTNums [%s] [ ssort + nsort ] illegal\n",
2496 (Int)TNAM_TNUM(i), 0L );
2497 success = 0;
2498 }
2499 }
2500 }
2501
2502 /* return success */
2503 return ! success;
2504 }
2505
2506
2507 /****************************************************************************
2508 **
2509 *F InitInfoLists() . . . . . . . . . . . . . . . . . table of init functions
2510 */
2511 static StructInitInfo module = {
2512 // init struct using C99 designated initializers; for a full list of
2513 // fields, please refer to the definition of StructInitInfo
2514 .type = MODULE_BUILTIN,
2515 .name = "lists",
2516 .initKernel = InitKernel,
2517 .initLibrary = InitLibrary,
2518 .checkInit = CheckInit,
2519 .postRestore = PostRestore
2520 };
2521
InitInfoLists(void)2522 StructInitInfo * InitInfoLists ( void )
2523 {
2524 return &module;
2525 }
2526