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 arithmetic operations package.
11 */
12
13 #include "ariths.h"
14
15 #include "bool.h"
16 #include "error.h"
17 #include "modules.h"
18 #include "opers.h"
19
20
21 #define RequireValue(funcname, val) \
22 do { \
23 if (!val) \
24 ErrorMayQuit(funcname ": method should have returned a value", \
25 0, 0); \
26 } while (0);
27
28
29 /****************************************************************************
30 **
31 *F * * * * * * * * * * * unary arithmetic operations * * * * * * * * * * * *
32 */
33
34 /****************************************************************************
35 **
36 *V ZeroFuncs[ <type> ] . . . . . . . . . . . . . . . . table of zero methods
37 */
38 ArithMethod1 ZeroFuncs [LAST_REAL_TNUM+1];
39
40
41 /****************************************************************************
42 **
43 *F ZeroObject( <obj> ) . . . . . . . . . . . . . . . . . . . . call methsel
44 */
45 static Obj ZEROOp;
46
ZeroObject(Obj obj)47 static Obj ZeroObject(Obj obj)
48
49 {
50 Obj val;
51 val = DoOperation1Args( ZEROOp, obj );
52 RequireValue("ZEROOp", val);
53 return val;
54 }
55
56
57 /****************************************************************************
58 **
59 *F VerboseZeroObject( <obj> ) . . . . . . . . . . . . call verbose methsel
60 */
VerboseZeroObject(Obj obj)61 static Obj VerboseZeroObject(Obj obj)
62
63 {
64 Obj val;
65 val = DoVerboseOperation1Args( ZEROOp, obj );
66 RequireValue("ZEROOp", val);
67 return val;
68 }
69
70
71 /****************************************************************************
72 **
73 *F InstallZeroObject( <verb> ) . . . . . . . . . . . . install zero methods
74 */
InstallZeroObject(Int verb)75 static void InstallZeroObject ( Int verb )
76 {
77 UInt t1; /* type of left operand */
78 ArithMethod1 func; /* zero function */
79
80 func = ( verb ? VerboseZeroObject : ZeroObject );
81 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
82 ZeroFuncs[t1] = func;
83 }
84 }
85
86
87 /****************************************************************************
88 **
89 *F FuncZERO( <self>, <obj> ) . . . . . . . . . . . . . . . . . . call 'ZERO'
90 */
FuncZERO(Obj self,Obj obj)91 static Obj FuncZERO(Obj self, Obj obj)
92 {
93 return ZERO(obj);
94 }
95
96 /****************************************************************************
97 **
98 *V ZeroMutFuncs[ <type> ] . . . . . . . . . . . . . . . . table of zero methods
99 */
100 ArithMethod1 ZeroMutFuncs [LAST_REAL_TNUM+1];
101
102
103 /****************************************************************************
104 **
105 *F ZeroMutObject( <obj> ) . . . . . . . . . . . . . . . . . . . . call methsel
106 */
107 static Obj ZeroOp;
108
ZeroMutObject(Obj obj)109 static Obj ZeroMutObject(Obj obj)
110
111 {
112 Obj val;
113 val = DoOperation1Args( ZeroOp, obj );
114 RequireValue("ZeroOp", val);
115 return val;
116 }
117
118
119 /****************************************************************************
120 **
121 *F VerboseZeroMutObject( <obj> ) . . . . . . . . . . . . call verbose methsel
122 */
VerboseZeroMutObject(Obj obj)123 static Obj VerboseZeroMutObject(Obj obj)
124
125 {
126 Obj val;
127 val = DoVerboseOperation1Args( ZeroOp, obj );
128 RequireValue("ZeroOp", val);
129 return val;
130 }
131
132
133 /****************************************************************************
134 **
135 *F InstallZeroMutObject( <verb> ) . . . . . . . . . . . . install zero methods
136 */
InstallZeroMutObject(Int verb)137 static void InstallZeroMutObject ( Int verb )
138 {
139 UInt t1; /* type of left operand */
140 ArithMethod1 func; /* zero function */
141
142 func = ( verb ? VerboseZeroMutObject : ZeroMutObject );
143 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
144 ZeroMutFuncs[t1] = func;
145 }
146 }
147
148
149 /****************************************************************************
150 **
151 *F FuncZERO_MUT( <self>, <obj> ) . . . . . . . . . . . . . . call 'ZERO_MUT'
152 */
FuncZERO_MUT(Obj self,Obj obj)153 static Obj FuncZERO_MUT(Obj self, Obj obj)
154 {
155 return ZERO_MUT(obj);
156 }
157
158
159 /****************************************************************************
160 **
161 *V AInvFuncs[ <type> ] . . . . . . . . . . table of additive inverse methods
162 *V AInvMutFuncs[ <type> ] . . . . . . . . table of additive inverse methods
163 ** which return mutable results
164 */
165 ArithMethod1 AInvFuncs [LAST_REAL_TNUM+1];
166 ArithMethod1 AInvMutFuncs[ LAST_REAL_TNUM + 1];
167
168
169 /****************************************************************************
170 **
171 *F AInvObj( <obj> ) . . . . . . . . . . . . . . . . . . . . . call methsel
172 */
173 static Obj AInvOp;
174
AInvObject(Obj obj)175 static Obj AInvObject(Obj obj)
176 {
177 Obj val;
178 val = DoOperation1Args( AInvOp, obj );
179 RequireValue("AInvOp", val);
180 return val;
181 }
182
183
184 /****************************************************************************
185 **
186 *F VerboseAInvObject( <obj> ) . . . . . . . . . . . . call verbose methsel
187 */
VerboseAInvObject(Obj obj)188 static Obj VerboseAInvObject(Obj obj)
189 {
190 Obj val;
191 val = DoVerboseOperation1Args( AInvOp, obj );
192 RequireValue("AInvOp", val);
193 return val;
194 }
195
196
197 /****************************************************************************
198 **
199 *F InstallAInvObject( <verb> ) . . . . . . install additive inverse methods
200 */
InstallAInvObject(Int verb)201 static void InstallAInvObject(Int verb)
202 {
203 UInt t1; /* type of left operand */
204 ArithMethod1 func; /* ainv function */
205
206 func = ( verb ? VerboseAInvObject : AInvObject );
207 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
208 AInvFuncs[t1] = func;
209 }
210 }
211
212
213 /****************************************************************************
214 **
215 *F FuncAINV( <self>, <obj> ) . . . . . . . . . . . . . . . . . . call 'AINV'
216 */
FuncAINV(Obj self,Obj obj)217 static Obj FuncAINV(Obj self, Obj obj)
218 {
219 return AINV(obj);
220 }
221
222 /****************************************************************************
223 **
224 *F AInvMutObject( <obj> ) . .. . . . . . . . . . . . . . . . . call methsel
225 */
226 static Obj AdditiveInverseOp;
227
AInvMutObject(Obj obj)228 static Obj AInvMutObject(Obj obj)
229 {
230 Obj val;
231 val = DoOperation1Args( AdditiveInverseOp, obj );
232 RequireValue("AdditiveInverseOp", val);
233 return val;
234 }
235
236
237 /****************************************************************************
238 **
239 *F VerboseAInvMutObject( <obj> ) . . . . . . . . . . . . call verbose methsel
240 */
VerboseAInvMutObject(Obj obj)241 static Obj VerboseAInvMutObject(Obj obj)
242 {
243 Obj val;
244 val = DoVerboseOperation1Args( AdditiveInverseOp, obj );
245 RequireValue("AdditiveInverseOp", val);
246 return val;
247 }
248
249
250 /****************************************************************************
251 **
252 *F InstallAInvMutObject( <verb> ) . . . . . install additive inverse methods
253 */
InstallAInvMutObject(Int verb)254 static void InstallAInvMutObject(Int verb)
255 {
256 UInt t1; /* type of left operand */
257 ArithMethod1 func; /* ainv function */
258
259 func = ( verb ? VerboseAInvMutObject : AInvMutObject );
260 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
261 AInvMutFuncs[t1] = func;
262 }
263 }
264
265
266 /****************************************************************************
267 **
268 *F FuncAINV_MUT( <self>, <obj> ) . . . . . . . . . . . . . . . . . . call 'AINV'
269 */
FuncAINV_MUT(Obj self,Obj obj)270 static Obj FuncAINV_MUT(Obj self, Obj obj)
271 {
272 return AINV_MUT(obj);
273 }
274
275
276 /****************************************************************************
277 **
278 *V OneFuncs[ <type> ] . . . . . . . . . . . . . . . . table of one methods
279 */
280 ArithMethod1 OneFuncs [LAST_REAL_TNUM+1];
281
282
283 /****************************************************************************
284 **
285 *F OneObject( <obj> ) . . . . . . . . . . . . . . . . . . . . call methsel
286 */
287 static Obj OneOp;
288
OneObject(Obj obj)289 static Obj OneObject(Obj obj)
290 {
291 Obj val;
292 val = DoOperation1Args( OneOp, obj );
293 RequireValue("OneOp", val);
294 return val;
295 }
296
297
298 /****************************************************************************
299 **
300 *F VerboseOneObject( <obj> ) . . . . . . . . . . . . . . . . . call methsel
301 */
VerboseOneObject(Obj obj)302 static Obj VerboseOneObject(Obj obj)
303 {
304 Obj val;
305 val = DoVerboseOperation1Args( OneOp, obj );
306 RequireValue("OneOp", val);
307 return val;
308 }
309
310
311 /****************************************************************************
312 **
313 *F InstallOneObject( <verb> ) . . . . . . . . . . . . . install one methods
314 */
InstallOneObject(Int verb)315 static void InstallOneObject ( Int verb )
316 {
317 UInt t1; /* type of left operand */
318 ArithMethod1 func; /* one function */
319
320 func = ( verb ? VerboseOneObject : OneObject );
321 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
322 OneFuncs[t1] = func;
323 }
324 }
325
326
327 /****************************************************************************
328 **
329 *F FuncONE( <self>, <obj> ) . . . . . . . . . . . . . . . . . call 'ONE'
330 */
FuncONE(Obj self,Obj obj)331 static Obj FuncONE(Obj self, Obj obj)
332 {
333 return ONE(obj);
334 }
335
336 /****************************************************************************
337 **
338 *V OneMutFuncs[ <type> ] . . . . .table of mutability retaining one methods
339 */
340 ArithMethod1 OneMutFuncs [LAST_REAL_TNUM+1];
341
342
343 /****************************************************************************
344 **
345 *F OneMutObject( <obj> ) . . . . . . . . . . . . . . . . . . . . call methsel
346 */
347 static Obj OneMutOp;
348
OneMutObject(Obj obj)349 static Obj OneMutObject(Obj obj)
350 {
351 Obj val;
352 val = DoOperation1Args( OneMutOp, obj );
353 RequireValue("ONEOp", val);
354 return val;
355 }
356
357
358 /****************************************************************************
359 **
360 *F VerboseOneMutObject( <obj> ) . . . . . . . . . . . . . . . call methsel
361 */
VerboseOneMutObject(Obj obj)362 static Obj VerboseOneMutObject(Obj obj)
363 {
364 Obj val;
365 val = DoVerboseOperation1Args( OneMutOp, obj );
366 RequireValue("ONEOp", val);
367 return val;
368 }
369
370
371 /****************************************************************************
372 **
373 *F InstallOneMutObject( <verb> ) . . . . . . . . . . . . . install one methods
374 */
InstallOneMutObject(Int verb)375 static void InstallOneMutObject ( Int verb )
376 {
377 UInt t1; /* type of left operand */
378 ArithMethod1 func; /* one function */
379
380 func = ( verb ? VerboseOneMutObject : OneMutObject );
381 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
382 OneMutFuncs[t1] = func;
383 }
384 }
385
386
387 /****************************************************************************
388 **
389 *F FuncONE_MUT( <self>, <obj> ) . . . . . . . . . . . . . . . .call 'ONE_MUT'
390 */
FuncONE_MUT(Obj self,Obj obj)391 static Obj FuncONE_MUT(Obj self, Obj obj)
392 {
393 return ONE_MUT(obj);
394 }
395
396
397 /****************************************************************************
398 **
399 *V InvFuncs[ <type> ] . . . . . . . . . . . . . table of inverse functions
400 */
401 ArithMethod1 InvFuncs [LAST_REAL_TNUM+1];
402
403
404 /****************************************************************************
405 **
406 *F InvObject( <obj> ) . . . . . . . . . . . . . . . . . . . . call methsel
407 */
408 static Obj InvOp;
409
InvObject(Obj obj)410 static Obj InvObject(Obj obj)
411 {
412 Obj val;
413 val = DoOperation1Args( InvOp, obj );
414 RequireValue("InvOp", val);
415 return val;
416 }
417
418
419 /****************************************************************************
420 **
421 *F VerboseInvObject( <obj> ) . . . . . . . . . . . . . . . . . call methsel
422 */
VerboseInvObject(Obj obj)423 static Obj VerboseInvObject(Obj obj)
424 {
425 Obj val;
426 val = DoVerboseOperation1Args( InvOp, obj );
427 RequireValue("InvOp", val);
428 return val;
429 }
430
431
432 /****************************************************************************
433 **
434 *F InstallInvObject( <verb> ) . . . . . . . . . . . install inverse methods
435 */
InstallInvObject(Int verb)436 static void InstallInvObject ( Int verb )
437 {
438 UInt t1; /* type of left operand */
439 ArithMethod1 func; /* inv function */
440
441 func = ( verb ? VerboseInvObject : InvObject );
442 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
443 InvFuncs[t1] = func;
444 }
445 }
446
447
448 /****************************************************************************
449 **
450 *F FuncINV( <self>, <obj> ) . . . . . . . . . . . . . . . . . . call 'INV'
451 */
FuncINV(Obj self,Obj obj)452 static Obj FuncINV(Obj self, Obj obj)
453 {
454 return INV( obj );
455 }
456
457
458 /****************************************************************************
459 **
460 *V InvMutFuncs[ <type> ] . table of mutability-preserving inverse functions
461 */
462 ArithMethod1 InvMutFuncs [LAST_REAL_TNUM+1];
463
464
465 /****************************************************************************
466 **
467 *F InvMutObject( <obj> ) . . . . . . . . . . . . . . .. . . . . call methsel
468 */
469 static Obj InvMutOp;
470
InvMutObject(Obj obj)471 static Obj InvMutObject(Obj obj)
472 {
473 Obj val;
474 val = DoOperation1Args( InvMutOp, obj );
475 RequireValue("INVOp", val);
476 return val;
477 }
478
479
480 /****************************************************************************
481 **
482 *F VerboseInvMutObject( <obj> ) . . . . . . . . . . . . . . . call methsel
483 */
VerboseInvMutObject(Obj obj)484 static Obj VerboseInvMutObject(Obj obj)
485 {
486 Obj val;
487 val = DoVerboseOperation1Args( InvMutOp, obj );
488 RequireValue("INVOp", val);
489 return val;
490 }
491
492
493 /****************************************************************************
494 **
495 *F InstallInvMutObject( <verb> ) install mutability preserving inverse methods
496 */
InstallInvMutObject(Int verb)497 static void InstallInvMutObject ( Int verb )
498 {
499 UInt t1; /* type of left operand */
500 ArithMethod1 func; /* inv function */
501
502 func = ( verb ? VerboseInvMutObject : InvMutObject );
503 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
504 InvMutFuncs[t1] = func;
505 }
506 }
507
508
509 /****************************************************************************
510 **
511 *F FuncINV_MUT( <self>, <obj> ) . . . . . . . . . . . . . call 'INV_MUT'
512 */
FuncINV_MUT(Obj self,Obj obj)513 static Obj FuncINV_MUT(Obj self, Obj obj)
514 {
515 return INV_MUT( obj );
516 }
517
518
519 /****************************************************************************
520 **
521 *F * * * * * * * * * * * * * comparison operations * * * * * * * * * * * * *
522 */
523
524 /****************************************************************************
525 **
526 *V EqFuncs[ <typeL> ][ <typeR> ] . . . . . . . . table of comparison methods
527 */
528 CompaMethod EqFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
529
530
531 /****************************************************************************
532 **
533 *F EqNot( <opL>, <opR> ) . . . . . . . . . . . . . . . . . . . . . not equal
534 */
EqNot(Obj opL,Obj opR)535 static Int EqNot(Obj opL, Obj opR)
536 {
537 return 0L;
538 }
539
540
541 /****************************************************************************
542 **
543 *F EqObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
544 */
545 Obj EqOper;
546
EqObject(Obj opL,Obj opR)547 Int EqObject (
548 Obj opL,
549 Obj opR )
550 {
551 return (DoOperation2Args( EqOper, opL, opR ) == True);
552 }
553
554
555 /****************************************************************************
556 **
557 *F VerboseEqObject( <opL>, <opR> ) . . . . . . . . . . . . . . call methsel
558 */
VerboseEqObject(Obj opL,Obj opR)559 static Int VerboseEqObject(Obj opL, Obj opR)
560 {
561 return (DoVerboseOperation2Args( EqOper, opL, opR ) == True);
562 }
563
564
565 /****************************************************************************
566 **
567 *F InstallEqObject( <verb> ) . . . . . . . . . . install comparison methods
568 */
InstallEqObject(Int verb)569 static void InstallEqObject ( Int verb )
570 {
571 UInt t1; /* type of left operand */
572 UInt t2; /* type of right operand */
573 CompaMethod func; /* equal function */
574
575 func = ( verb ? VerboseEqObject : EqObject );
576 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
577 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
578 EqFuncs[t1][t2] = func;
579 EqFuncs[t2][t1] = func;
580 }
581 }
582 }
583
584
585 /****************************************************************************
586 **
587 *F FuncEQ( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . . call 'EQ'
588 */
FuncEQ(Obj self,Obj opL,Obj opR)589 static Obj FuncEQ(Obj self, Obj opL, Obj opR)
590 {
591 /* if both operands are T_MACFLOAT, we use the comparison method in all cases,
592 even if the objects are identical. In this manner, we can have 0./0. != 0./0. as
593 the IEEE754 standard requires.
594 if (TNUM_OBJ(opL) == T_MACFLOAT && TNUM_OBJ(opR) == T_MACFLOAT)
595 return (*EqFuncs[T_MACFLOAT][T_MACFLOAT])(opL,opR) ? True : False;
596 */
597
598 return (EQ( opL, opR ) ? True : False);
599 }
600
601
602 /****************************************************************************
603 **
604 *V LtFuncs[ <typeL> ][ <typeR> ] . . . . . . . . table of comparison methods
605 */
606 CompaMethod LtFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
607
608
609 /****************************************************************************
610 **
611 *F LtObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
612 */
613 Obj LtOper;
614
LtObject(Obj opL,Obj opR)615 static Int LtObject(Obj opL, Obj opR)
616 {
617 return (DoOperation2Args( LtOper, opL, opR ) == True);
618 }
619
620
621 /****************************************************************************
622 **
623 *F VerboseLtObject( <opL>, <opR> ) . . . . . . . . . . . . . . call methsel
624 */
VerboseLtObject(Obj opL,Obj opR)625 static Int VerboseLtObject(Obj opL, Obj opR)
626 {
627 return (DoVerboseOperation2Args( LtOper, opL, opR ) == True);
628 }
629
630
631 /****************************************************************************
632 **
633 *F InstallLtObject( <verb> ) . . . . . . . . . . . install less than methods
634 */
InstallLtObject(Int verb)635 static void InstallLtObject ( Int verb )
636 {
637 UInt t1; /* type of left operand */
638 UInt t2; /* type of right operand */
639 CompaMethod func; /* less than function */
640
641 func = ( verb ? VerboseLtObject : LtObject );
642 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
643 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
644 LtFuncs[t1][t2] = func;
645 LtFuncs[t2][t1] = func;
646 }
647 }
648 }
649
650
651 /****************************************************************************
652 **
653 *F FuncLT( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . . call 'LT'
654 */
FuncLT(Obj self,Obj opL,Obj opR)655 static Obj FuncLT(Obj self, Obj opL, Obj opR)
656 {
657 return (LT( opL, opR ) ? True : False);
658 }
659
660
661 /****************************************************************************
662 **
663 *V InFuncs[ <typeL> ][ <typeR> ] . . . . . . . . table of membership methods
664 */
665 CompaMethod InFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
666
667
668 /****************************************************************************
669 **
670 *F InUndefined( <self>, <opL>, <opR> ) . . . . . . . . . . . . . cannot 'in'
671 */
InUndefined(Obj opL,Obj opR)672 static Int InUndefined(Obj opL, Obj opR)
673 {
674 ErrorMayQuit("operations: IN of %s and %s is not defined",
675 (Int)TNAM_OBJ(opL), (Int)TNAM_OBJ(opR));
676 }
677
678
679 /****************************************************************************
680 **
681 *F InObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
682 */
683 static Obj InOper;
684
InObject(Obj opL,Obj opR)685 static Int InObject(Obj opL, Obj opR)
686 {
687 return (DoOperation2Args( InOper, opL, opR ) == True);
688 }
689
690
691 /****************************************************************************
692 **
693 *F VerboseInObject( <opL>, <opR> ) . . . . . . . . . . . . . . call methsel
694 */
VerboseInObject(Obj opL,Obj opR)695 static Int VerboseInObject(Obj opL, Obj opR)
696 {
697 return (DoVerboseOperation2Args( InOper, opL, opR ) == True);
698 }
699
700
701 /****************************************************************************
702 **
703 *F InstallInObject( <verb> ) . . . . . . . . . . . . . . install in methods
704 */
InstallInObject(Int verb)705 static void InstallInObject ( Int verb )
706 {
707 UInt t1; /* type of left operand */
708 UInt t2; /* type of right operand */
709 CompaMethod func; /* in function */
710
711 func = ( verb ? VerboseInObject : InObject );
712 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
713 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
714 InFuncs[t1][t2] = func;
715 InFuncs[t2][t1] = func;
716 }
717 }
718 }
719
720
721 /****************************************************************************
722 **
723 *F FuncIN( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . . call 'IN'
724 */
FuncIN(Obj self,Obj opL,Obj opR)725 static Obj FuncIN(Obj self, Obj opL, Obj opR)
726 {
727 return (IN( opL, opR ) ? True : False);
728 }
729
730
731 /****************************************************************************
732 **
733 *F * * * * * * * * * * * binary arithmetic operations * * * * * * * * * * * *
734 */
735
736 /****************************************************************************
737 **
738 *V SumFuncs[ <typeL> ][ <typeR> ] . . . . . . . . . . table of sum methods
739 */
740 ArithMethod2 SumFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
741
742
743 /****************************************************************************
744 **
745 *F SumObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
746 */
747 Obj SumOper;
748
SumObject(Obj opL,Obj opR)749 static Obj SumObject(Obj opL, Obj opR)
750 {
751 Obj val;
752 val = DoOperation2Args( SumOper, opL, opR );
753 RequireValue("SUM", val);
754 return val;
755 }
756
757
758 /****************************************************************************
759 **
760 *F VerboseSumObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
761 */
VerboseSumObject(Obj opL,Obj opR)762 static Obj VerboseSumObject(Obj opL, Obj opR)
763 {
764 Obj val;
765 val = DoVerboseOperation2Args( SumOper, opL, opR );
766 RequireValue("SUM", val);
767 return val;
768 }
769
770
771 /****************************************************************************
772 **
773 *F InstallSumObject( <verb> ) . . . . . . . . . . . . . install sum methods
774 */
InstallSumObject(Int verb)775 static void InstallSumObject ( Int verb )
776 {
777 UInt t1; /* type of left operand */
778 UInt t2; /* type of right operand */
779 ArithMethod2 func; /* sum function */
780
781 func = ( verb ? VerboseSumObject : SumObject );
782 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
783 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
784 SumFuncs[t1][t2] = func;
785 SumFuncs[t2][t1] = func;
786 }
787 }
788 }
789
790
791 /****************************************************************************
792 **
793 *F FuncSUM( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . call 'SUM'
794 */
FuncSUM(Obj self,Obj opL,Obj opR)795 static Obj FuncSUM(Obj self, Obj opL, Obj opR)
796 {
797 return SUM( opL, opR );
798 }
799
800
801 /****************************************************************************
802 **
803 *V DiffFuncs[ <typeL> ][ <typeR> ] . . . . . . . table of difference methods
804 */
805 ArithMethod2 DiffFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
806
807
808 /****************************************************************************
809 **
810 *F DiffDefault( <opL>, <opR> ) . . . . . . . . . . . . call 'SUM' and 'AINV'
811 */
DiffDefault(Obj opL,Obj opR)812 static Obj DiffDefault(Obj opL, Obj opR)
813 {
814 Obj tmp;
815
816 tmp = AINV( opR );
817 return SUM( opL, tmp );
818 }
819
820
821 /****************************************************************************
822 **
823 *F DiffObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . call methsel
824 */
825 static Obj DiffOper;
826
DiffObject(Obj opL,Obj opR)827 static Obj DiffObject(Obj opL, Obj opR)
828 {
829 Obj val;
830 val = DoOperation2Args( DiffOper, opL, opR );
831 RequireValue("DIFF", val);
832 return val;
833 }
834
835
836 /****************************************************************************
837 **
838 *F VerboseDiffObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
839 */
VerboseDiffObject(Obj opL,Obj opR)840 static Obj VerboseDiffObject(Obj opL, Obj opR)
841 {
842 Obj val;
843 val = DoVerboseOperation2Args( DiffOper, opL, opR );
844 RequireValue("DIFF", val);
845 return val;
846 }
847
848
849 /****************************************************************************
850 **
851 *F InstallDiffObject( <verb> ) . . . . . . . . . install difference methods
852 */
InstallDiffObject(Int verb)853 static void InstallDiffObject ( Int verb )
854 {
855 UInt t1; /* type of left operand */
856 UInt t2; /* type of right operand */
857 ArithMethod2 func; /* difference function */
858
859 func = ( verb ? VerboseDiffObject : DiffObject );
860 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
861 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
862 DiffFuncs[t1][t2] = func;
863 DiffFuncs[t2][t1] = func;
864 }
865 }
866 }
867
868
869 /****************************************************************************
870 **
871 *F FuncDIFF_DEFAULT( <self>, <opL>, <opR> ) . . . . . . call 'DiffDefault'
872 */
FuncDIFF_DEFAULT(Obj self,Obj opL,Obj opR)873 static Obj FuncDIFF_DEFAULT(Obj self, Obj opL, Obj opR)
874 {
875 return DiffDefault( opL, opR );
876 }
877
878
879 /****************************************************************************
880 **
881 *F FuncDIFF( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . call 'DIFF'
882 */
FuncDIFF(Obj self,Obj opL,Obj opR)883 static Obj FuncDIFF(Obj self, Obj opL, Obj opR)
884 {
885 return DIFF( opL, opR );
886 }
887
888
889 /****************************************************************************
890 **
891 *V ProdFuncs[ <typeL> ][ <typeR> ] . . . . . . . . table of product methods
892 */
893 ArithMethod2 ProdFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
894
895
896 /****************************************************************************
897 **
898 *F ProdObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . call methsel
899 */
900 static Obj ProdOper;
901
ProdObject(Obj opL,Obj opR)902 static Obj ProdObject(Obj opL, Obj opR)
903 {
904 Obj val;
905 val = DoOperation2Args( ProdOper, opL, opR );
906 RequireValue("PROD", val);
907 return val;
908 }
909
910
911 /****************************************************************************
912 **
913 *F VerboseProdObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
914 */
VerboseProdObject(Obj opL,Obj opR)915 static Obj VerboseProdObject(Obj opL, Obj opR)
916 {
917 Obj val;
918 val = DoVerboseOperation2Args( ProdOper, opL, opR );
919 RequireValue("PROD", val);
920 return val;
921 }
922
923
924 /****************************************************************************
925 **
926 *F InstallProdObject( <verb> ) . . . . . . . . . . . install product methods
927 */
InstallProdObject(Int verb)928 static void InstallProdObject ( Int verb )
929 {
930 UInt t1; /* type of left operand */
931 UInt t2; /* type of right operand */
932 ArithMethod2 func; /* product function */
933
934 func = ( verb ? VerboseProdObject : ProdObject );
935 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
936 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
937 ProdFuncs[t1][t2] = func;
938 ProdFuncs[t2][t1] = func;
939 }
940 }
941 }
942
943
944 /****************************************************************************
945 **
946 *F FuncPROD( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . call 'PROD'
947 */
FuncPROD(Obj self,Obj opL,Obj opR)948 static Obj FuncPROD(Obj self, Obj opL, Obj opR)
949 {
950 return PROD( opL, opR );
951 }
952
953
954 /****************************************************************************
955 **
956 *V QuoFuncs[ <typeL> ][ <typeR> ] . . . . . . . . table of quotient methods
957 */
958 ArithMethod2 QuoFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
959
960
961 /****************************************************************************
962 **
963 *F QuoDefault( <opL>, <opR> ) . . . . . . . . . . . . call 'INV' and 'PROD'
964 */
QuoDefault(Obj opL,Obj opR)965 static Obj QuoDefault(Obj opL, Obj opR)
966 {
967 Obj tmp;
968 tmp = INV_MUT( opR );
969 return PROD( opL, tmp );
970 }
971
972
973 /****************************************************************************
974 **
975 *F QuoObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
976 */
977 static Obj QuoOper;
978
QuoObject(Obj opL,Obj opR)979 static Obj QuoObject(Obj opL, Obj opR)
980 {
981 Obj val;
982 val = DoOperation2Args( QuoOper, opL, opR );
983 RequireValue("QUO", val);
984 return val;
985 }
986
987
988 /****************************************************************************
989 **
990 *F VerboseQuoObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
991 */
VerboseQuoObject(Obj opL,Obj opR)992 static Obj VerboseQuoObject(Obj opL, Obj opR)
993 {
994 Obj val;
995 val = DoVerboseOperation2Args( QuoOper, opL, opR );
996 RequireValue("QUO", val);
997 return val;
998 }
999
1000
1001 /****************************************************************************
1002 **
1003 *F InstallQuoObject( <verb> ) . . . . . . . . . . install quotient methods
1004 */
InstallQuoObject(Int verb)1005 static void InstallQuoObject ( Int verb )
1006 {
1007 UInt t1; /* type of left operand */
1008 UInt t2; /* type of right operand */
1009 ArithMethod2 func; /* quotient function */
1010
1011 func = ( verb ? VerboseQuoObject : QuoObject );
1012 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
1013 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1014 QuoFuncs[t1][t2] = func;
1015 QuoFuncs[t2][t1] = func;
1016 }
1017 }
1018 }
1019
1020
1021 /****************************************************************************
1022 **
1023 *F FuncQUO_DEFAULT( <self>, <opL>, <opR> ) . . . . . . . . call 'QuoDefault'
1024 */
FuncQUO_DEFAULT(Obj self,Obj opL,Obj opR)1025 static Obj FuncQUO_DEFAULT(Obj self, Obj opL, Obj opR)
1026 {
1027 return QuoDefault( opL, opR );
1028 }
1029
1030
1031 /****************************************************************************
1032 **
1033 *F FuncQUO( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . call 'QUO'
1034 */
FuncQUO(Obj self,Obj opL,Obj opR)1035 static Obj FuncQUO(Obj self, Obj opL, Obj opR)
1036 {
1037 return QUO( opL, opR );
1038 }
1039
1040
1041 /****************************************************************************
1042 **
1043 *V LQuoFuncs[ <typeL> ][ <typeR> ] . . . . . table of left quotient methods
1044 */
1045 ArithMethod2 LQuoFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
1046
1047
1048 /****************************************************************************
1049 **
1050 *F LQuoDefault( <opL>, <opR> ) . . . . . . . . . . . . call 'INV' and 'PROD'
1051 */
LQuoDefault(Obj opL,Obj opR)1052 static Obj LQuoDefault(Obj opL, Obj opR)
1053 {
1054 Obj tmp;
1055 tmp = INV_MUT( opL );
1056 return PROD( tmp, opR );
1057 }
1058
1059
1060 /****************************************************************************
1061 **
1062 *F LQuoObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . call methsel
1063 */
1064 static Obj LQuoOper;
1065
LQuoObject(Obj opL,Obj opR)1066 static Obj LQuoObject(Obj opL, Obj opR)
1067 {
1068 Obj val;
1069 val = DoOperation2Args( LQuoOper, opL, opR );
1070 RequireValue("LeftQuotient", val);
1071 return val;
1072 }
1073
1074
1075 /****************************************************************************
1076 **
1077 *F VerboseLQuoObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
1078 */
VerboseLQuoObject(Obj opL,Obj opR)1079 static Obj VerboseLQuoObject(Obj opL, Obj opR)
1080 {
1081 Obj val;
1082 val = DoOperation2Args( LQuoOper, opL, opR );
1083 RequireValue("LeftQuotient", val);
1084 return val;
1085 }
1086
1087
1088 /****************************************************************************
1089 **
1090 *F InstallLQuoObject( <verb> ) . . . . . . . . install left quotient methods
1091 */
InstallLQuoObject(Int verb)1092 static void InstallLQuoObject ( Int verb )
1093 {
1094 UInt t1; /* type of left operand */
1095 UInt t2; /* type of right operand */
1096 ArithMethod2 func; /* left quotient function */
1097
1098 func = ( verb ? VerboseLQuoObject : LQuoObject );
1099 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
1100 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1101 LQuoFuncs[t1][t2] = func;
1102 LQuoFuncs[t2][t1] = func;
1103 }
1104 }
1105 }
1106
1107
1108 /****************************************************************************
1109 **
1110 *F FuncLQUO_DEFAULT( <self>, <opL>, <opR> ) . . . . . . call 'LQuoDefault'
1111 */
FuncLQUO_DEFAULT(Obj self,Obj opL,Obj opR)1112 static Obj FuncLQUO_DEFAULT(Obj self, Obj opL, Obj opR)
1113 {
1114 return LQuoDefault( opL, opR );
1115 }
1116
1117
1118 /****************************************************************************
1119 **
1120 *F FuncLQUO( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . call 'LQUO'
1121 */
FuncLQUO(Obj self,Obj opL,Obj opR)1122 static Obj FuncLQUO(Obj self, Obj opL, Obj opR)
1123 {
1124 return LQUO( opL, opR );
1125 }
1126
1127
1128 /****************************************************************************
1129 **
1130 *V PowFuncs[ <typeL> ][ <typeR> ] . . . . . . . . . table of power methods
1131 */
1132 ArithMethod2 PowFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
1133
1134
1135 /****************************************************************************
1136 **
1137 *F PowDefault( <opL>, <opR> ) . . . . . . . . . . . call 'LQUO' and 'PROD'
1138 */
PowDefault(Obj opL,Obj opR)1139 static Obj PowDefault(Obj opL, Obj opR)
1140 {
1141 Obj tmp;
1142 tmp = LQUO( opR, opL );
1143 return PROD( tmp, opR );
1144 }
1145
1146
1147 /****************************************************************************
1148 **
1149 *F PowObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
1150 */
1151 static Obj PowOper;
1152
PowObject(Obj opL,Obj opR)1153 static Obj PowObject(Obj opL, Obj opR)
1154 {
1155 Obj val;
1156 val = DoOperation2Args( PowOper, opL, opR );
1157 RequireValue("POW", val);
1158 return val;
1159 }
1160
1161
1162 /****************************************************************************
1163 **
1164 *F VerbosePowObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
1165 */
VerbosePowObject(Obj opL,Obj opR)1166 static Obj VerbosePowObject(Obj opL, Obj opR)
1167 {
1168
1169 Obj val;
1170 val = DoVerboseOperation2Args( PowOper, opL, opR );
1171 RequireValue("POW", val);
1172 return val;
1173 }
1174
1175
1176 /****************************************************************************
1177 **
1178 *F InstallPowObject( <verb> ) . . . . . . . . . . install the power methods
1179 */
InstallPowObject(Int verb)1180 static void InstallPowObject ( Int verb )
1181 {
1182 UInt t1; /* type of left operand */
1183 UInt t2; /* type of right operand */
1184 ArithMethod2 func; /* power function */
1185
1186 func = ( verb ? VerbosePowObject : PowObject );
1187 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
1188 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1189 PowFuncs[t1][t2] = func;
1190 PowFuncs[t2][t1] = func;
1191 }
1192 }
1193 }
1194
1195
1196 /****************************************************************************
1197 **
1198 *F FuncPOW_DEFAULT( <self>, <opL>, <opR> ) . . . . . . . . call 'PowDefault'
1199 */
FuncPOW_DEFAULT(Obj self,Obj opL,Obj opR)1200 static Obj FuncPOW_DEFAULT(Obj self, Obj opL, Obj opR)
1201 {
1202 return PowDefault( opL, opR );
1203 }
1204
1205
1206 /****************************************************************************
1207 **
1208 *F FuncPOW( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . call 'POW'
1209 */
FuncPOW(Obj self,Obj opL,Obj opR)1210 static Obj FuncPOW(Obj self, Obj opL, Obj opR)
1211 {
1212 return POW( opL, opR );
1213 }
1214
1215
1216 /****************************************************************************
1217 **
1218 *V CommFuncs[ <typeL> ][ <typeR> ] . . . . . . . table of commutator methods
1219 */
1220 ArithMethod2 CommFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
1221
1222
1223 /****************************************************************************
1224 **
1225 *F CommDefault( <opL>, <opR> ) . . . . . . . . . . . call 'LQUO' and 'PROD'
1226 */
CommDefault(Obj opL,Obj opR)1227 static Obj CommDefault(Obj opL, Obj opR)
1228 {
1229 Obj tmp1;
1230 Obj tmp2;
1231 tmp1 = PROD( opR, opL );
1232 tmp2 = PROD( opL, opR );
1233 return LQUO( tmp1, tmp2 );
1234 }
1235
1236
1237 /****************************************************************************
1238 **
1239 *F CommObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . call methsel
1240 */
1241 static Obj CommOper;
1242
CommObject(Obj opL,Obj opR)1243 static Obj CommObject(Obj opL, Obj opR)
1244 {
1245 Obj val;
1246 val = DoOperation2Args( CommOper, opL, opR );
1247 RequireValue("Comm", val);
1248 return val;
1249 }
1250
1251
1252 /****************************************************************************
1253 **
1254 *F VerboseCommObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
1255 */
VerboseCommObject(Obj opL,Obj opR)1256 static Obj VerboseCommObject(Obj opL, Obj opR)
1257 {
1258 Obj val;
1259 val = DoVerboseOperation2Args( CommOper, opL, opR );
1260 RequireValue("Comm", val);
1261 return val;
1262 }
1263
1264
1265 /****************************************************************************
1266 **
1267 *F InstallCommObject( <verb> ) . . . . . . . . . install commutator methods
1268 */
InstallCommObject(Int verb)1269 static void InstallCommObject ( Int verb )
1270 {
1271 UInt t1; /* type of left operand */
1272 UInt t2; /* type of right operand */
1273 ArithMethod2 func; /* commutator function */
1274
1275 func = ( verb ? VerboseCommObject : CommObject );
1276 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
1277 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1278 CommFuncs[t1][t2] = func;
1279 CommFuncs[t2][t1] = func;
1280 }
1281 }
1282 }
1283
1284
1285 /****************************************************************************
1286 **
1287 *F FuncCOMM_DEFAULT( <self>, <opL>, <opR> ) . . . . . . call 'CommDefault'
1288 */
FuncCOMM_DEFAULT(Obj self,Obj opL,Obj opR)1289 static Obj FuncCOMM_DEFAULT(Obj self, Obj opL, Obj opR)
1290 {
1291 return CommDefault( opL, opR );
1292 }
1293
1294
1295 /****************************************************************************
1296 **
1297 *F FuncCOMM( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . call 'COMM'
1298 */
FuncCOMM(Obj self,Obj opL,Obj opR)1299 static Obj FuncCOMM(Obj self, Obj opL, Obj opR)
1300 {
1301 return COMM( opL, opR );
1302 }
1303
1304
1305 /****************************************************************************
1306 **
1307 *V ModFuncs[ <typeL> ][ <typeR> ] . . . . . . . table of remainder methods
1308 */
1309 ArithMethod2 ModFuncs [LAST_REAL_TNUM+1][LAST_REAL_TNUM+1];
1310
1311
1312
1313 /****************************************************************************
1314 **
1315 *F ModObject( <opL>, <opR> ) . . . . . . . . . . . . . . . . . call methsel
1316 */
1317 static Obj ModOper;
1318
ModObject(Obj opL,Obj opR)1319 static Obj ModObject(Obj opL, Obj opR)
1320 {
1321 Obj val;
1322 val = DoOperation2Args( ModOper, opL, opR );
1323 RequireValue("mod", val);
1324 return val;
1325 }
1326
1327
1328 /****************************************************************************
1329 **
1330 *F VerboseModObject( <opL>, <opR> ) . . . . . . . . . . . . . call methsel
1331 */
VerboseModObject(Obj opL,Obj opR)1332 static Obj VerboseModObject(Obj opL, Obj opR)
1333 {
1334 Obj val;
1335 val = DoVerboseOperation2Args( ModOper, opL, opR );
1336 RequireValue("mod", val);
1337 return val;
1338 }
1339
1340
1341 /****************************************************************************
1342 **
1343 *F InstallModObject( <verb> ) . . . . . . . . . . . install the mod methods
1344 */
InstallModObject(Int verb)1345 static void InstallModObject ( Int verb )
1346 {
1347 UInt t1; /* type of left operand */
1348 UInt t2; /* type of right operand */
1349 ArithMethod2 func; /* mod function */
1350
1351 func = ( verb ? VerboseModObject : ModObject );
1352 for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
1353 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1354 ModFuncs[t1][t2] = func;
1355 ModFuncs[t2][t1] = func;
1356 }
1357 }
1358 }
1359
1360
1361 /****************************************************************************
1362 **
1363 *F FuncMOD( <self>, <opL>, <opR> ) . . . . . . . . . . . . . . . call 'MOD'
1364 */
FuncMOD(Obj self,Obj opL,Obj opR)1365 static Obj FuncMOD(Obj self, Obj opL, Obj opR)
1366 {
1367 return MOD( opL, opR );
1368 }
1369
1370
1371 /****************************************************************************
1372 **
1373 *F ChangeArithDoOperations( <oper>, <verb> )
1374 */
ChangeArithDoOperations(Obj oper,Int verb)1375 void ChangeArithDoOperations(Obj oper, Int verb)
1376 {
1377 /* catch infix operations */
1378 if ( oper == EqOper ) { InstallEqObject(verb); }
1379 if ( oper == LtOper ) { InstallLtObject(verb); }
1380 if ( oper == InOper ) { InstallInObject(verb); }
1381 if ( oper == SumOper ) { InstallSumObject(verb); }
1382 if ( oper == DiffOper ) { InstallDiffObject(verb); }
1383 if ( oper == ProdOper ) { InstallProdObject(verb); }
1384 if ( oper == QuoOper ) { InstallQuoObject(verb); }
1385 if ( oper == LQuoOper ) { InstallLQuoObject(verb); }
1386 if ( oper == PowOper ) { InstallPowObject(verb); }
1387 if ( oper == CommOper ) { InstallCommObject(verb); }
1388 if ( oper == ModOper ) { InstallModObject(verb); }
1389
1390 if ( oper == InvOp ) { InstallInvObject(verb); }
1391 if ( oper == OneOp ) { InstallOneObject(verb); }
1392 if ( oper == AInvOp ) { InstallAInvObject(verb); }
1393 if ( oper == ZEROOp ) { InstallZeroObject(verb); }
1394
1395 if ( oper == InvMutOp ) { InstallInvMutObject(verb); }
1396 if ( oper == OneMutOp ) { InstallOneMutObject(verb); }
1397 if ( oper == AdditiveInverseOp ) { InstallAInvMutObject(verb); }
1398 if ( oper == ZeroOp ) { InstallZeroMutObject(verb); }
1399 }
1400
1401
1402 /****************************************************************************
1403 **
1404 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
1405 */
1406
1407 /****************************************************************************
1408 **
1409 *V GVarOpers . . . . . . . . . . . . . . . . . list of operations to export
1410 */
1411 static StructGVarOper GVarOpers [] = {
1412
1413 GVAR_OPER(EQ, 2, "opL, opR", &EqOper),
1414 GVAR_OPER(LT, 2, "opL, opR", &LtOper),
1415 GVAR_OPER(IN, 2, "opL, opR", &InOper),
1416 GVAR_OPER(SUM, 2, "opL, opR", &SumOper),
1417 GVAR_OPER(DIFF, 2, "opL, opR", &DiffOper),
1418 GVAR_OPER(PROD, 2, "opL, opR", &ProdOper),
1419 GVAR_OPER(QUO, 2, "opL, opR", &QuoOper),
1420 GVAR_OPER(LQUO, 2, "opL, opR", &LQuoOper),
1421 GVAR_OPER(POW, 2, "opL, opR", &PowOper),
1422 GVAR_OPER(COMM, 2, "opL, opR", &CommOper),
1423 GVAR_OPER(MOD, 2, "opL, opR", &ModOper),
1424 GVAR_OPER(ZERO, 1, "op", &ZEROOp),
1425 GVAR_OPER(ZERO_MUT, 1, "op", &ZeroOp),
1426 GVAR_OPER(AINV, 1, "op", &AInvOp),
1427 GVAR_OPER(AINV_MUT, 1, "op", &AdditiveInverseOp),
1428 GVAR_OPER(ONE, 1, "op", &OneOp),
1429 GVAR_OPER(ONE_MUT, 1, "op", &OneMutOp),
1430 GVAR_OPER(INV, 1, "op", &InvOp),
1431 GVAR_OPER(INV_MUT, 1, "op", &InvMutOp),
1432 { 0, 0, 0, 0, 0, 0 }
1433
1434 };
1435
1436
1437 /****************************************************************************
1438 **
1439 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1440 */
1441 static StructGVarFunc GVarFuncs [] = {
1442
1443 GVAR_FUNC(COMM_DEFAULT, 2, "opL, opR"),
1444 GVAR_FUNC(POW_DEFAULT, 2, "opL, opR"),
1445 GVAR_FUNC(LQUO_DEFAULT, 2, "opL, opR"),
1446 GVAR_FUNC(QUO_DEFAULT, 2, "opL, opR"),
1447 GVAR_FUNC(DIFF_DEFAULT, 2, "opL, opR"),
1448 { 0, 0, 0, 0, 0 }
1449
1450 };
1451
1452
1453 /****************************************************************************
1454 **
1455 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1456 */
InitKernel(StructInitInfo * module)1457 static Int InitKernel (
1458 StructInitInfo * module )
1459 {
1460 UInt t1; /* type of left operand */
1461 UInt t2; /* type of right operand */
1462
1463 /* init filters and functions */
1464 InitHdlrOpersFromTable( GVarOpers );
1465 InitHdlrFuncsFromTable( GVarFuncs );
1466
1467 /* make and install the 'ZERO' arithmetic operation */
1468 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1469 assert(ZeroFuncs[t1] == 0);
1470 ZeroFuncs[t1] = ZeroObject;
1471 }
1472 InstallZeroObject(0);
1473
1474 /* make and install the 'ZERO_MUT' arithmetic operation */
1475 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1476 assert(ZeroMutFuncs[t1] == 0);
1477 ZeroMutFuncs[t1] = ZeroMutObject;
1478 }
1479 InstallZeroMutObject(0);
1480
1481 /* make and install the 'AINV' arithmetic operation */
1482 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1483 assert(AInvFuncs[t1] == 0);
1484 AInvFuncs[t1] = AInvObject;
1485 }
1486 InstallAInvObject(0);
1487
1488 /* make and install the 'AINV_MUT' arithmetic operation */
1489 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1490 assert(AInvMutFuncs[t1] == 0);
1491 AInvMutFuncs[t1] = AInvMutObject;
1492 }
1493 InstallAInvMutObject(0);
1494
1495 /* make and install the 'ONE' arithmetic operation */
1496 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1497 assert(OneFuncs[t1] == 0);
1498 OneFuncs[t1] = OneObject;
1499 }
1500 InstallOneObject(0);
1501
1502 /* make and install the 'ONE' arithmetic operation */
1503 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1504 assert(OneMutFuncs[t1] == 0);
1505 OneMutFuncs[t1] = OneMutObject;
1506 }
1507 InstallOneMutObject(0);
1508
1509 /* make and install the 'INV' arithmetic operation */
1510 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1511 assert(InvFuncs[t1] == 0);
1512 InvFuncs[t1] = InvObject;
1513 }
1514 InstallInvObject(0);
1515
1516 /* make and install the 'INV' arithmetic operation */
1517 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1518 assert(InvMutFuncs[t1] == 0);
1519 InvMutFuncs[t1] = InvMutObject;
1520 }
1521 InstallInvMutObject(0);
1522
1523 /* make and install the 'EQ' comparison operation */
1524 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1525 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1526 assert(EqFuncs[t1][t2] == 0);
1527 EqFuncs[t1][t2] = EqNot;
1528 }
1529 }
1530 InstallEqObject(0);
1531
1532 /* make and install the 'LT' comparison operation */
1533 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1534 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1535 assert(LtFuncs[t1][t2] == 0);
1536 LtFuncs[t1][t2] = LtObject;
1537 }
1538 }
1539 InstallLtObject(0);
1540
1541 /* make and install the 'IN' comparison operation */
1542 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1543 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1544 assert(InFuncs[t1][t2] == 0);
1545 InFuncs[t1][t2] = InUndefined;
1546 }
1547 }
1548 InstallInObject(0);
1549
1550 /* make and install the 'SUM' arithmetic operation */
1551 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1552 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1553 assert(SumFuncs[t1][t2] == 0);
1554 SumFuncs[t1][t2] = SumObject;
1555 }
1556 }
1557 InstallSumObject(0);
1558
1559 /* make and install the 'DIFF' arithmetic operation */
1560 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1561 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1562 assert(DiffFuncs[t1][t2] == 0);
1563 DiffFuncs[t1][t2] = DiffDefault;
1564 }
1565 }
1566 InstallDiffObject(0);
1567
1568 /* make and install the 'PROD' arithmetic operation */
1569 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1570 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1571 assert(ProdFuncs[t1][t2] == 0);
1572 ProdFuncs[t1][t2] = ProdObject;
1573 }
1574 }
1575 InstallProdObject(0);
1576
1577 /* make and install the 'QUO' arithmetic operation */
1578 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1579 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1580 assert(QuoFuncs[t1][t2] == 0);
1581 QuoFuncs[t1][t2] = QuoDefault;
1582 }
1583 }
1584 InstallQuoObject(0);
1585
1586 /* make and install the 'LQUO' arithmetic operation */
1587 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1588 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1589 assert(LQuoFuncs[t1][t2] == 0);
1590 LQuoFuncs[t1][t2] = LQuoDefault;
1591 }
1592 }
1593 InstallLQuoObject(0);
1594
1595 /* make and install the 'POW' arithmetic operation */
1596 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1597 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1598 assert(PowFuncs[t1][t2] == 0);
1599 PowFuncs[t1][t2] = PowObject;
1600 }
1601 }
1602 InstallPowObject(0);
1603
1604 /* make and install the 'COMM' arithmetic operation */
1605 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1606 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1607 assert(CommFuncs[t1][t2] == 0);
1608 CommFuncs[t1][t2] = CommDefault;
1609 }
1610 }
1611 InstallCommObject(0);
1612
1613 /* make and install the 'MOD' arithmetic operation */
1614 for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
1615 for ( t2 = FIRST_REAL_TNUM; t2 <= LAST_REAL_TNUM; t2++ ) {
1616 assert(ModFuncs[t1][t2] == 0);
1617 ModFuncs[t1][t2] = ModObject;
1618 }
1619 }
1620 InstallModObject(0);
1621
1622
1623 /* return success */
1624 return 0;
1625 }
1626
1627
1628 /****************************************************************************
1629 **
1630 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
1631 */
InitLibrary(StructInitInfo * module)1632 static Int InitLibrary (
1633 StructInitInfo * module )
1634 {
1635 /* init filters and functions */
1636 InitGVarOpersFromTable( GVarOpers );
1637 InitGVarFuncsFromTable( GVarFuncs );
1638
1639 /* return success */
1640 return 0;
1641 }
1642
1643
1644 /****************************************************************************
1645 **
1646 *F InitInfoAriths() . . . . . . . . . . . . . . . . table of init functions
1647 */
1648 static StructInitInfo module = {
1649 // init struct using C99 designated initializers; for a full list of
1650 // fields, please refer to the definition of StructInitInfo
1651 .type = MODULE_BUILTIN,
1652 .name = "ariths",
1653 .initKernel = InitKernel,
1654 .initLibrary = InitLibrary,
1655 };
1656
InitInfoAriths(void)1657 StructInitInfo * InitInfoAriths ( void )
1658 {
1659 return &module;
1660 }
1661