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 declares the functions of the filters, operations, attributes,
11 ** and properties package.
12 */
13
14 #ifndef GAP_OPERS_H
15 #define GAP_OPERS_H
16
17 #include "bool.h"
18 #include "calls.h"
19 #include "system.h"
20
21
22 enum {
23 MAX_OPER_ARGS = 6
24 };
25
26 /****************************************************************************
27 **
28 **
29 */
30 typedef struct {
31 // an operation is a T_FUNCTION with additional data
32 FuncBag func;
33
34 // flag 1 list of an 'and' filter
35 Obj flag1;
36
37 // flag 2 list of an 'and' filter
38 Obj flag2;
39
40 // flags of a filter
41 Obj flags;
42
43 // setter of a filter
44 Obj setter;
45
46 // tester of a filter
47 Obj tester;
48
49 // method list of an operation
50 Obj methods[MAX_OPER_ARGS+1];
51
52 // cache of an operation
53 Obj cache[MAX_OPER_ARGS+1];
54
55 // small integer encoding a set of bit flags with information about the
56 // operation, see OperExtras below
57 //
58 // note: this is encoded as an integer object, and not just stored
59 // directly as C bitfield, to avoid the need for a custom marking function
60 // which does not call 'MarkBag' on this field (while that would be safe
61 // to do with GASMAN, it may not be in alternate GC implementations)
62 Obj extra;
63 } OperBag;
64
65 enum OperExtras {
66 OPER_IS_ATTR_STORING = (1 << 0),
67 OPER_IS_FILTER = (1 << 1),
68 };
69
70 /****************************************************************************
71 **
72 *V TRY_NEXT_METHOD . . . . . . . . . . . . . . . . . 'TRY_NEXT_METHOD' flag
73 */
74 extern Obj TRY_NEXT_METHOD;
75
76
77 /****************************************************************************
78 **
79 *F IS_OPERATION( <obj> ) . . . . . . . . . . check if object is an operation
80 */
IS_OPERATION(Obj obj)81 EXPORT_INLINE Int IS_OPERATION(Obj obj)
82 {
83 return TNUM_OBJ(obj) == T_FUNCTION && SIZE_OBJ(obj) == sizeof(OperBag);
84 }
85
86
87 /****************************************************************************
88 **
89 *F OPER
90 */
OPER(Obj oper)91 EXPORT_INLINE OperBag * OPER(Obj oper)
92 {
93 GAP_ASSERT(IS_OPERATION(oper));
94 return (OperBag *)ADDR_OBJ(oper);
95 }
96
CONST_OPER(Obj oper)97 EXPORT_INLINE const OperBag * CONST_OPER(Obj oper)
98 {
99 GAP_ASSERT(IS_OPERATION(oper));
100 return (const OperBag *)CONST_ADDR_OBJ(oper);
101 }
102
103
104 /****************************************************************************
105 **
106 *F FLAG1_FILT( <oper> ) . . . . . . . . . . flag 1 list of an 'and' filter
107 */
FLAG1_FILT(Obj oper)108 EXPORT_INLINE Obj FLAG1_FILT(Obj oper)
109 {
110 return CONST_OPER(oper)->flag1;
111 }
112
SET_FLAG1_FILT(Obj oper,Obj x)113 EXPORT_INLINE void SET_FLAG1_FILT(Obj oper, Obj x)
114 {
115 OPER(oper)->flag1 = x;
116 }
117
118
119 /****************************************************************************
120 **
121 *F FLAG2_FILT( <oper> ) . . . . . . . . . . flag 2 list of an 'and' filter
122 */
FLAG2_FILT(Obj oper)123 EXPORT_INLINE Obj FLAG2_FILT(Obj oper)
124 {
125 return CONST_OPER(oper)->flag2;
126 }
127
SET_FLAG2_FILT(Obj oper,Obj x)128 EXPORT_INLINE void SET_FLAG2_FILT(Obj oper, Obj x)
129 {
130 OPER(oper)->flag2 = x;
131 }
132
133
134 /****************************************************************************
135 **
136 *F FLAGS_FILT( <oper> ) . . . . . . . . . . . . . . . . . flags of a filter
137 */
FLAGS_FILT(Obj oper)138 EXPORT_INLINE Obj FLAGS_FILT(Obj oper)
139 {
140 return CONST_OPER(oper)->flags;
141 }
142
SET_FLAGS_FILT(Obj oper,Obj x)143 EXPORT_INLINE void SET_FLAGS_FILT(Obj oper, Obj x)
144 {
145 OPER(oper)->flags = x;
146 }
147
148
149 /****************************************************************************
150 **
151 *F SETTER_FILT( <oper> ) . . . . . . . . . . . . . . . . setter of a filter
152 */
SETTR_FILT(Obj oper)153 EXPORT_INLINE Obj SETTR_FILT(Obj oper)
154 {
155 return CONST_OPER(oper)->setter;
156 }
157
SET_SETTR_FILT(Obj oper,Obj x)158 EXPORT_INLINE void SET_SETTR_FILT(Obj oper, Obj x)
159 {
160 OPER(oper)->setter = x;
161 }
162
163
164 /****************************************************************************
165 **
166 *F TESTR_FILT( <oper> ) . . . . . . . . . . . . . . . . tester of a filter
167 */
TESTR_FILT(Obj oper)168 EXPORT_INLINE Obj TESTR_FILT(Obj oper)
169 {
170 return CONST_OPER(oper)->tester;
171 }
172
SET_TESTR_FILT(Obj oper,Obj x)173 EXPORT_INLINE void SET_TESTR_FILT(Obj oper, Obj x)
174 {
175 OPER(oper)->tester = x;
176 }
177
178
179 /****************************************************************************
180 **
181 *F METHS_OPER( <oper> ) . . . . . . . . . . . . method list of an operation
182 */
METHS_OPER(Obj oper,Int i)183 EXPORT_INLINE Obj METHS_OPER(Obj oper, Int i)
184 {
185 GAP_ASSERT(0 <= i && i <= MAX_OPER_ARGS);
186 return CONST_OPER(oper)->methods[i];
187 }
188
SET_METHS_OPER(Obj oper,Int i,Obj x)189 EXPORT_INLINE void SET_METHS_OPER(Obj oper, Int i, Obj x)
190 {
191 GAP_ASSERT(0 <= i && i <= MAX_OPER_ARGS);
192 OPER(oper)->methods[i] = x;
193 }
194
195
196 /****************************************************************************
197 **
198 *F CACHE_OPER( <oper> ) . . . . . . . . . . . . . . . cache of an operation
199 */
CACHE_OPER(Obj oper,Int i)200 EXPORT_INLINE Obj CACHE_OPER(Obj oper, Int i)
201 {
202 GAP_ASSERT(0 <= i && i <= MAX_OPER_ARGS);
203 return CONST_OPER(oper)->cache[i];
204 }
205
SET_CACHE_OPER(Obj oper,Int i,Obj x)206 EXPORT_INLINE void SET_CACHE_OPER(Obj oper, Int i, Obj x)
207 {
208 GAP_ASSERT(0 <= i && i <= MAX_OPER_ARGS);
209 OPER(oper)->cache[i] = x;
210 }
211
212
213 /****************************************************************************
214 **
215 *F ENABLED_ATTR( <oper> ) . . . . true if the operation is an attribute and
216 ** storing is enabled (default) else false
217 */
ENABLED_ATTR(Obj oper)218 EXPORT_INLINE Int ENABLED_ATTR(Obj oper)
219 {
220 Obj val = CONST_OPER(oper)->extra;
221 Int v = val ? INT_INTOBJ(val) : 0;
222 return v & OPER_IS_ATTR_STORING;
223 }
224
225
226 /****************************************************************************
227 **
228 *F SET_ENABLED_ATTR( <oper>, <on> ) . set a new value that records whether
229 ** storing is enabled for an operation
230 */
SET_ENABLED_ATTR(Obj oper,Int on)231 EXPORT_INLINE void SET_ENABLED_ATTR(Obj oper, Int on)
232 {
233 Obj val = CONST_OPER(oper)->extra;
234 Int v = val ? INT_INTOBJ(val) : 0;
235 if (on)
236 v |= OPER_IS_ATTR_STORING;
237 else
238 v &= ~OPER_IS_ATTR_STORING;
239 OPER(oper)->extra = INTOBJ_INT(v);
240 }
241
242 /****************************************************************************
243 **
244 *F IS_FILTER( <oper> ) . . . . . . . . . . . . . check if object is a filter
245 */
IS_FILTER(Obj oper)246 EXPORT_INLINE Int IS_FILTER(Obj oper)
247 {
248 if (!IS_OPERATION(oper))
249 return 0;
250 Obj val = CONST_OPER(oper)->extra;
251 Int v = val ? INT_INTOBJ(val) : 0;
252 return v & OPER_IS_FILTER;
253 }
254
255
256 /****************************************************************************
257 **
258 *F SET_IS_FILTER( <oper> ) . . . . . . . . . . . mark operation as a filter
259 */
SET_IS_FILTER(Obj oper)260 EXPORT_INLINE void SET_IS_FILTER(Obj oper)
261 {
262 Obj val = CONST_OPER(oper)->extra;
263 Int v = val ? INT_INTOBJ(val) : 0;
264 v |= OPER_IS_FILTER;
265 OPER(oper)->extra = INTOBJ_INT(v);
266 }
267
268
269 /****************************************************************************
270 **
271 *F * * * * * * * * * * * * internal flags functions * * * * * * * * * * * * *
272 */
273
274
275 /****************************************************************************
276 **
277 *F NEW_FLAGS( <flags>, <len> ) . . . . . . . . . . . . . . . new flags list
278 */
NEW_FLAGS(UInt len)279 EXPORT_INLINE Obj NEW_FLAGS(UInt len)
280 {
281 UInt size = (3 + ((len+BIPEB-1) >> LBIPEB)) * sizeof(Obj);
282 Obj flags = NewBag(T_FLAGS, size);
283 return flags;
284 }
285
286
287 /****************************************************************************
288 **
289 *F TRUES_FLAGS( <flags> ) . . . . . . . . . . list of trues of a flags list
290 **
291 ** returns the list of trues of <flags> or 0 if the list is not known yet.
292 */
TRUES_FLAGS(Obj flags)293 EXPORT_INLINE Obj TRUES_FLAGS(Obj flags)
294 {
295 GAP_ASSERT(TNUM_OBJ(flags) == T_FLAGS);
296 return CONST_ADDR_OBJ(flags)[0];
297 }
298
299
300 /****************************************************************************
301 **
302 *F SET_TRUES_FLAGS( <flags>, <trues> ) . set number of trues of a flags list
303 */
SET_TRUES_FLAGS(Obj flags,Obj trues)304 EXPORT_INLINE void SET_TRUES_FLAGS(Obj flags, Obj trues)
305 {
306 GAP_ASSERT(TNUM_OBJ(flags) == T_FLAGS);
307 ADDR_OBJ(flags)[0] = trues;
308 }
309
310
311 /****************************************************************************
312 **
313 *F HASH_FLAGS( <flags> ) . . . . . . . . . . . . hash value of <flags> or 0
314 */
HASH_FLAGS(Obj flags)315 EXPORT_INLINE Obj HASH_FLAGS(Obj flags)
316 {
317 GAP_ASSERT(TNUM_OBJ(flags) == T_FLAGS);
318 return CONST_ADDR_OBJ(flags)[1];
319 }
320
321
322 /****************************************************************************
323 **
324 *F SET_HASH_FLAGS( <flags>, <hash> ) . . . . . . . . . . . . . . . set hash
325 */
SET_HASH_FLAGS(Obj flags,Obj hash)326 EXPORT_INLINE void SET_HASH_FLAGS(Obj flags, Obj hash)
327 {
328 GAP_ASSERT(TNUM_OBJ(flags) == T_FLAGS);
329 ADDR_OBJ(flags)[1] = hash;
330 }
331
332
333 /****************************************************************************
334 **
335 *F LEN_FLAGS( <flags> ) . . . . . . . . . . . . . . length of a flags list
336 */
LEN_FLAGS(Obj flags)337 EXPORT_INLINE UInt LEN_FLAGS(Obj flags)
338 {
339 return (SIZE_OBJ(flags) / sizeof(Obj) - 3) << LBIPEB;
340 }
341
342
343 /****************************************************************************
344 **
345 *F AND_CACHE_FLAGS( <flags> ) . . . . . . . . . 'and' cache of a flags list
346 */
AND_CACHE_FLAGS(Obj list)347 EXPORT_INLINE Obj AND_CACHE_FLAGS(Obj list)
348 {
349 GAP_ASSERT(TNUM_OBJ(list) == T_FLAGS);
350 return CONST_ADDR_OBJ(list)[2];
351 }
352
353
354 /****************************************************************************
355 **
356 *F SET_AND_CACHE_FLAGS( <flags>, <len> ) set the 'and' cache of a flags list
357 */
SET_AND_CACHE_FLAGS(Obj flags,Obj andc)358 EXPORT_INLINE void SET_AND_CACHE_FLAGS(Obj flags, Obj andc)
359 {
360 GAP_ASSERT(TNUM_OBJ(flags) == T_FLAGS);
361 ADDR_OBJ(flags)[2] = andc;
362 }
363
364
365 /****************************************************************************
366 **
367 *F NRB_FLAGS( <flags> ) . . . . . . number of basic blocks of a flags list
368 */
NRB_FLAGS(Obj flags)369 EXPORT_INLINE UInt NRB_FLAGS(Obj flags)
370 {
371 return SIZE_OBJ(flags) / sizeof(Obj) - 3;
372 }
373
374
375 /****************************************************************************
376 **
377 *F BLOCKS_FLAGS( <flags> ) . . . . . . . . . . . . data area of a flags list
378 */
BLOCKS_FLAGS(Obj flags)379 EXPORT_INLINE UInt * BLOCKS_FLAGS(Obj flags)
380 {
381 GAP_ASSERT(TNUM_OBJ(flags) == T_FLAGS);
382 return (UInt *)(ADDR_OBJ(flags) + 3);
383 }
384
385
386 /****************************************************************************
387 **
388 *F BLOCK_ELM_FLAGS( <list>, <pos> ) . . . . . . . . block of a flags list
389 **
390 ** 'BLOCK_ELM_FLAGS' return the block containing the <pos>-th element of the
391 ** flags list <list> as a UInt value, which is also a valid left hand side.
392 ** <pos> must be a positive integer less than or equal to the length of
393 ** <list>.
394 */
BLOCK_ELM_FLAGS(Obj list,UInt pos)395 EXPORT_INLINE UInt BLOCK_ELM_FLAGS(Obj list, UInt pos)
396 {
397 GAP_ASSERT(TNUM_OBJ(list) == T_FLAGS);
398 GAP_ASSERT(pos <= LEN_FLAGS(list));
399 return BLOCKS_FLAGS(list)[(pos - 1) >> LBIPEB];
400 }
401
402 /****************************************************************************
403 **
404 *F MASK_POS_FLAGS( <pos> ) . . . . . bit mask for position of a flags list
405 **
406 ** 'MASK_POS_FLAGS(<pos>)' returns a UInt with a single set bit in position
407 ** '(<pos>-1) % BIPEB',
408 ** useful for accessing the <pos>-th element of a 'FLAGS' list.
409 **
410 */
MASK_POS_FLAGS(UInt pos)411 EXPORT_INLINE UInt MASK_POS_FLAGS(UInt pos)
412 {
413 return ((UInt)1) << ((pos - 1) & (BIPEB - 1));
414 }
415
416
417 /****************************************************************************
418 **
419 *F ELM_FLAGS( <list>, <pos> ) . . . . . . . . . . . element of a flags list
420 **
421 ** 'ELM_FLAGS' return the <pos>-th element of the flags list <list>, which
422 ** is either 'true' or 'false'. <pos> must be a positive integer less than
423 ** or equal to the length of <hdList>.
424 **
425 ** 'C_ELM_FLAGS' returns a result which it is better to use inside the kernel
426 ** since the C compiler can't know that True != False. Using C_ELM_FLAGS
427 ** gives slightly nicer C code and potential for a little more optimisation.
428 */
C_ELM_FLAGS(Obj list,UInt pos)429 EXPORT_INLINE Int C_ELM_FLAGS(Obj list, UInt pos)
430 {
431 return (BLOCK_ELM_FLAGS(list, pos) & MASK_POS_FLAGS(pos)) != 0;
432 }
433
ELM_FLAGS(Obj list,UInt pos)434 EXPORT_INLINE Obj ELM_FLAGS(Obj list, UInt pos)
435 {
436 return C_ELM_FLAGS(list, pos) ? True : False;
437 }
438
SAFE_C_ELM_FLAGS(Obj flags,UInt pos)439 EXPORT_INLINE Int SAFE_C_ELM_FLAGS(Obj flags, UInt pos)
440 {
441 return (pos <= LEN_FLAGS(flags)) ? C_ELM_FLAGS(flags, pos) : 0;
442 }
443
SAFE_ELM_FLAGS(Obj list,UInt pos)444 EXPORT_INLINE Obj SAFE_ELM_FLAGS(Obj list, UInt pos)
445 {
446 return SAFE_C_ELM_FLAGS(list, pos) ? True : False;
447 }
448
449
450 /****************************************************************************
451 **
452 *F SET_ELM_FLAGS( <list>, <pos>, <val> ) . . set an element of a flags list
453 **
454 ** 'SET_ELM_FLAGS' sets the element at position <pos> in the flags list
455 ** <list> to True. <pos> must be a positive integer less than or
456 ** equal to the length of <hdList>.
457 */
SET_ELM_FLAGS(Obj list,UInt pos)458 EXPORT_INLINE void SET_ELM_FLAGS(Obj list, UInt pos)
459 {
460 GAP_ASSERT(TNUM_OBJ(list) == T_FLAGS);
461 GAP_ASSERT(pos <= LEN_FLAGS(list));
462 BLOCKS_FLAGS(list)[(pos - 1) >> LBIPEB] |= MASK_POS_FLAGS(pos);
463 }
464
465
466 /****************************************************************************
467 **
468 *F FuncIS_SUBSET_FLAGS( <self>, <flags1>, <flags2> ) . . . . . . subset test
469 */
470
471 Obj FuncIS_SUBSET_FLAGS(Obj self, Obj flags1, Obj flags2);
472
473 /****************************************************************************
474 **
475 *F * * * * * * * * * * * internal filter functions * * * * * * * * * * * * *
476 */
477
478
479 /****************************************************************************
480 **
481 *V SET_FILTER_OBJ . . . . . . . . . . . . library function to set a filter
482 */
483 extern Obj SET_FILTER_OBJ;
484
485
486 /****************************************************************************
487 **
488 *V RESET_FILTER_OBJ . . . . . . . . . . library function to reset a filter
489 */
490 extern Obj RESET_FILTER_OBJ;
491
492
493 /****************************************************************************
494 **
495 *F DoFilter( <self>, <obj> ) . . . . . . . . . . default handler for filters
496 */
497 Obj DoFilter(Obj self, Obj obj);
498
499
500 /****************************************************************************
501 **
502 *F NewFilter( <name>, <nams>, <hdlr> ) . . . . . . . . . . make a new filter
503 */
504 Obj NewFilter(Obj name, Obj nams, ObjFunc hdlr);
505
506
507 /****************************************************************************
508 **
509 *F NewAndFilter( <filt1>, <filt2> ) . . . . . make a new concatenated filter
510 */
511 Obj NewAndFilter(Obj oper1, Obj oper2);
512
513
514 /****************************************************************************
515 **
516 *V ReturnTrueFilter . . . . . . . . . . . . . . . . the return 'true' filter
517 */
518 extern Obj ReturnTrueFilter;
519
520
521 /****************************************************************************
522 **
523 *F * * * * * * * * * * internal operation functions * * * * * * * * * * * *
524 */
525
526
527 /****************************************************************************
528 **
529 ** Default handlers for operations
530 */
531 Obj DoOperation0Args(Obj oper);
532
533 Obj DoOperation1Args(Obj oper, Obj arg1);
534
535 Obj DoOperation2Args(Obj oper, Obj arg1, Obj arg2);
536
537 Obj DoOperation3Args(Obj oper, Obj arg1, Obj arg2, Obj arg3);
538
539 Obj DoOperation4Args(Obj oper, Obj arg1, Obj arg2, Obj arg3, Obj arg4);
540
541 Obj DoOperation5Args(
542 Obj oper, Obj arg1, Obj arg2, Obj arg3, Obj arg4, Obj arg5);
543
544 Obj DoOperation6Args(
545 Obj oper, Obj arg1, Obj arg2, Obj arg3, Obj arg4, Obj arg5, Obj arg6);
546
547 Obj DoOperationXArgs(Obj self, Obj args);
548
549
550 /****************************************************************************
551 **
552 ** Default handlers for verbose operations
553 */
554 Obj DoVerboseOperation0Args(Obj oper);
555
556 Obj DoVerboseOperation1Args(Obj oper, Obj arg1);
557
558 Obj DoVerboseOperation2Args(Obj oper, Obj arg1, Obj arg2);
559
560 Obj DoVerboseOperation3Args(Obj oper, Obj arg1, Obj arg2, Obj arg3);
561
562 Obj DoVerboseOperation4Args(Obj oper, Obj arg1, Obj arg2, Obj arg3, Obj arg4);
563
564 Obj DoVerboseOperation5Args(
565 Obj oper, Obj arg1, Obj arg2, Obj arg3, Obj arg4, Obj arg5);
566
567 Obj DoVerboseOperation6Args(
568 Obj oper, Obj arg1, Obj arg2, Obj arg3, Obj arg4, Obj arg5, Obj arg6);
569
570 Obj DoVerboseOperationXArgs(Obj self, Obj args);
571
572
573 /****************************************************************************
574 **
575 *F NewOperation( <name> ) . . . . . . . . . . . . . . . make a new operation
576 */
577 Obj NewOperation(Obj name, Int narg, Obj nams, ObjFunc hdlr);
578
579
580 /****************************************************************************
581 **
582 *F DoAttribute( <self>, <obj> ) . . . . . . . default handler for attributes
583 */
584 Obj DoAttribute(Obj self, Obj obj);
585
586
587 /****************************************************************************
588 **
589 *F DoTestAttribute( <self>, <obj> ) . default handler for attribute testers
590 */
591 Obj DoTestAttribute(Obj self, Obj obj);
592
593
594 /****************************************************************************
595 **
596 *F NewAttribute( <name> ) . . . . . . . . . . . . . . . make a new attribute
597 */
598 Obj NewAttribute(Obj name, Obj nams, ObjFunc hdlr);
599
600
601 /****************************************************************************
602 **
603 *F DoProperty( <self>, <obj> ) . . . . . . . default handler for properties
604 */
605 Obj DoProperty(Obj self, Obj obj);
606
607
608 /****************************************************************************
609 **
610 *F NewProperty( <name> ) . . . . . . . . . . . . . . . . make a new property
611 */
612 Obj NewProperty(Obj name, Obj nams, ObjFunc hdlr);
613
614
615 /****************************************************************************
616 **
617 *F InstallMethodArgs( <oper>, <func> ) . . . . . . . . . . . clone function
618 **
619 ** There is a problem with uncompleted functions: if they are cloned then
620 ** only the orignal and not the clone will be completed. Therefore the
621 ** clone must postpone the real cloning.
622 */
623 void InstallMethodArgs(Obj oper, Obj func);
624
625
626 /****************************************************************************
627 **
628 *F ChangeDoOperations( <oper>, <verb> )
629 */
630 void ChangeDoOperations(Obj oper, Int verb);
631
632
633 /****************************************************************************
634 **
635 *F SaveOperationExtras( <oper> ) . . . additional savng for functions which
636 ** are operations
637 **
638 ** This is called by SaveFunction when the function bag is too large to be
639 ** a simple function, and so must be an operation
640 **
641 */
642 void SaveOperationExtras(Obj oper);
643
644
645 /****************************************************************************
646 **
647 *F LoadOperationExtras( <oper> ) . . additional loading for functions which
648 ** are operations
649 **
650 ** This is called by LoadFunction when the function bag is too large to be
651 ** a simple function, and so must be an operation
652 **
653 */
654 void LoadOperationExtras(Obj oper);
655
656
657 /****************************************************************************
658 **
659 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
660 */
661
662
663 /****************************************************************************
664 **
665 *F InitInfoOpers() . . . . . . . . . . . . . . . . . table of init functions
666 */
667 StructInitInfo * InitInfoOpers ( void );
668
669
670 #endif // GAP_OPERS_H
671