![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to arith.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / parse|
Return to arith.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / parse |
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/parse/arith.c,v 1.2 1999/11/18 05:42:02 noro Exp $ */
2: #include "ca.h"
3: #include "parse.h"
4:
5: struct oAFUNC {
6: void (*add)();
7: void (*sub)();
8: void (*mul)();
9: void (*div)();
10: void (*pwr)();
11: void (*chsgn)();
12: int (*comp)();
13: };
14:
15: struct oARF arf[6];
16: ARF addfs, subfs, mulfs, divfs, remfs, pwrfs;
17:
18: void divsdc();
19:
20: struct oAFUNC afunc[] = {
21: /* ??? */ {0,0,0,0,0,0,0},
22: /* O_N */ {addnum,subnum,mulnum,divnum,pwrnum,chsgnnum,compnum},
23: /* O_P */ {addp,subp,mulp,divr,pwrp,chsgnp,compp},
24: /* O_R */ {addr,subr,mulr,divr,pwrr,chsgnr,compr},
25: /* O_LIST */ {notdef,notdef,notdef,notdef,notdef,notdef,complist},
26: /* O_VECT */ {addvect,subvect,mulvect,divvect,notdef,chsgnvect,compvect},
27: /* O_MAT */ {addmat,submat,mulmat,divmat,pwrmat,chsgnmat,compmat},
28: /* O_STR */ {addstr,notdef,notdef,notdef,notdef,notdef,compstr},
29: /* O_COMP */ {addcomp,subcomp,mulcomp,divcomp,pwrcomp,chsgncomp,compcomp},
30: /* O_DP */ {addd,subd,muld,divsdc,notdef,chsgnd,compd},
31: /* O_UI */ {notdef,notdef,notdef,notdef,notdef,notdef,compui},
32: /* O_GF2MAT */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef},
33: /* O_ERR */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef},
34: /* O_GFMMAT */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef},
35: };
36:
37: void arf_init() {
38: addfs = &arf[0]; addfs->name = "+"; addfs->fp = arf_add;
39: subfs = &arf[1]; subfs->name = "-"; subfs->fp = arf_sub;
40: mulfs = &arf[2]; mulfs->name = "*"; mulfs->fp = arf_mul;
41: divfs = &arf[3]; divfs->name = "/"; divfs->fp = arf_div;
42: remfs = &arf[4]; remfs->name = "%"; remfs->fp = arf_remain;
43: pwrfs = &arf[5]; pwrfs->name = "^"; pwrfs->fp = arf_pwr;
44: }
45:
46: void arf_add(vl,a,b,r)
47: VL vl;
48: Obj a,b,*r;
49: {
50: int mid;
51:
52: if ( !a )
53: *r = b;
54: else if ( !b )
55: *r = a;
56: else if ( OID(a) == OID(b) )
57: (*afunc[OID(a)].add)(vl,a,b,r);
58: else if ( (mid = MAX(OID(a),OID(b))) <= O_R )
59: (*afunc[mid].add)(vl,a,b,r);
60: else
61: notdef(vl,a,b,r);
62: }
63:
64: void arf_sub(vl,a,b,r)
65: VL vl;
66: Obj a,b,*r;
67: {
68: int mid;
69:
70: if ( !a )
71: if ( !b )
72: *r = 0;
73: else
74: (*afunc[OID(b)].chsgn)(b,r);
75: else if ( !b )
76: *r = a;
77: else if ( OID(a) == OID(b) )
78: (*afunc[OID(a)].sub)(vl,a,b,r);
79: else if ( (mid = MAX(OID(a),OID(b))) <= O_R )
80: (*afunc[mid].sub)(vl,a,b,r);
81: else
82: notdef(vl,a,b,r);
83: }
84:
85: void arf_mul(vl,a,b,r)
86: VL vl;
87: Obj a,b,*r;
88: {
89: int mid;
90:
91: if ( !a || !b )
92: *r = 0;
93: else if ( OID(a) == OID(b) )
94: (*(afunc[OID(a)].mul))(vl,a,b,r);
95: else if ( (mid = MAX(OID(a),OID(b))) <= O_R ||
96: (mid == O_MAT) || (mid == O_VECT) || (mid == O_DP) )
97: (*afunc[mid].mul)(vl,a,b,r);
98: else
99: notdef(vl,a,b,r);
100: }
101:
102: void arf_div(vl,a,b,r)
103: VL vl;
104: Obj a,b,*r;
105: {
106: int mid;
107:
108: if ( !b )
109: error("div : division by 0");
110: if ( !a )
111: *r = 0;
112: else if ( (OID(a) == OID(b)) )
113: (*(afunc[OID(a)].div))(vl,a,b,r);
114: else if ( (mid = MAX(OID(a),OID(b))) <= O_R ||
115: (mid == O_MAT) || (mid == O_VECT) || (mid == O_DP) )
116: (*afunc[mid].div)(vl,a,b,r);
117: else
118: notdef(vl,a,b,r);
119: }
120:
121: void arf_remain(vl,a,b,r)
122: VL vl;
123: Obj a,b,*r;
124: {
125: if ( !b )
126: error("rem : division by 0");
127: else if ( !a )
128: *r = 0;
129: else if ( MAX(OID(a),OID(b)) <= O_P )
130: cmp((Q)b,(P)a,(P *)r);
131: else
132: notdef(vl,a,b,r);
133: }
134:
135: void arf_pwr(vl,a,e,r)
136: VL vl;
137: Obj a,e,*r;
138: {
139: R t;
140:
141: if ( !a )
142: *r = 0;
143: else if ( !e )
144: *r = (pointer)ONE;
145: else if ( (OID(e) <= O_N) && INT(e) ) {
146: if ( (OID(a) == O_P) && (SGN((Q)e) < 0) ) {
147: MKRAT((P)a,(P)ONE,1,t);
148: (*(afunc[O_R].pwr))(vl,t,e,r);
149: } else
150: (*(afunc[OID(a)].pwr))(vl,a,e,r);
151: } else if ( OID(a) <= O_R )
152: mkpow(vl,a,e,r);
153: else
154: notdef(vl,a,e,r);
155: }
156:
157: void arf_chsgn(a,r)
158: Obj a,*r;
159: {
160: if ( !a )
161: *r = 0;
162: else
163: (*(afunc[OID(a)].chsgn))(a,r);
164: }
165:
166: int arf_comp(vl,a,b)
167: VL vl;
168: Obj a,b;
169: {
170: if ( !a )
171: if ( !b )
172: return 0;
173: else
174: return (*afunc[OID(b)].comp)(vl,a,b);
175: else if ( !b )
176: return (*afunc[OID(a)].comp)(vl,a,b);
177: else if ( OID(a) != OID(b) )
178: return OID(a)>OID(b) ? 1 : -1;
179: else
180: return (*afunc[OID(a)].comp)(vl,a,b);
181: }
182:
183: int complist(vl,a,b)
184: VL vl;
185: LIST a,b;
186: {
187: int i,t;
188: NODE an,bn;
189:
190: if ( !a )
191: if ( !b )
192: return 0;
193: else
194: return -1;
195: else if ( !b )
196: return 1;
197: for ( i = 0, an = BDY(a); an; i++, an = NEXT(an) );
198: for ( an = BDY(b); an; i--, an = NEXT(an) );
199: if ( i )
200: return i > 0 ? 1 : -1;
201: for ( an = BDY(a), bn = BDY(b); an; an = NEXT(an), bn = NEXT(bn) )
202: if ( t = arf_comp(vl,BDY(an),BDY(bn)) )
203: return t;
204: return 0;
205: }