Annotation of OpenXM_contrib2/asir2000/builtin/dp.c, Revision 1.33
1.5 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.6 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.5 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.33 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.32 2003/06/19 07:08:18 noro Exp $
1.5 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "base.h"
52: #include "parse.h"
53:
1.8 noro 54: extern int dp_nelim;
55: extern int dp_order_pair_length;
56: extern struct order_pair *dp_order_pair;
57: extern struct order_spec dp_current_spec;
58:
1.11 noro 59: int do_weyl;
1.1 noro 60:
1.32 noro 61: void Pdp_mul_trunc(),Pdp_quo();
1.1 noro 62: void Pdp_ord(), Pdp_ptod(), Pdp_dtop();
63: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
64: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
1.30 ohara 65: void Pdp_set_sugar();
1.1 noro 66: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
67: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
1.9 noro 68: void Pdp_nf(),Pdp_true_nf();
1.1 noro 69: void Pdp_nf_mod(),Pdp_true_nf_mod();
70: void Pdp_criB(),Pdp_nelim();
1.9 noro 71: void Pdp_minp(),Pdp_sp_mod();
1.1 noro 72: void Pdp_homo(),Pdp_dehomo();
1.16 noro 73: void Pdp_gr_mod_main(),Pdp_gr_f_main();
1.1 noro 74: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
1.16 noro 75: void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main();
1.1 noro 76: void Pdp_gr_print();
1.28 noro 77: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f();
1.8 noro 78: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
79: void Pdp_cont();
1.22 noro 80: void Pdp_gr_checklist();
1.1 noro 81:
1.13 noro 82: void Pdp_weyl_red();
83: void Pdp_weyl_sp();
84: void Pdp_weyl_nf(),Pdp_weyl_nf_mod();
1.16 noro 85: void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main();
86: void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main();
1.13 noro 87: void Pdp_weyl_mul(),Pdp_weyl_mul_mod();
1.15 noro 88: void Pdp_weyl_set_weight();
1.24 noro 89: void Pdp_set_weight();
1.16 noro 90: void Pdp_nf_f(),Pdp_weyl_nf_f();
91: void Pdp_lnf_f();
1.33 ! noro 92: void Pnd_gr();
1.11 noro 93:
1.25 noro 94: LIST remove_zero_from_list(LIST);
95:
1.1 noro 96: struct ftab dp_tab[] = {
1.8 noro 97: /* content reduction */
1.1 noro 98: {"dp_ptozp",Pdp_ptozp,1},
99: {"dp_ptozp2",Pdp_ptozp2,2},
100: {"dp_prim",Pdp_prim,1},
1.8 noro 101: {"dp_red_coef",Pdp_red_coef,2},
102: {"dp_cont",Pdp_cont,1},
103:
1.11 noro 104: /* polynomial ring */
1.32 noro 105: /* special operations */
106: {"dp_mul_trunc",Pdp_mul_trunc,3},
107: {"dp_quo",Pdp_quo,2},
108:
1.8 noro 109: /* s-poly */
110: {"dp_sp",Pdp_sp,2},
111: {"dp_sp_mod",Pdp_sp_mod,3},
112:
113: /* m-reduction */
1.1 noro 114: {"dp_red",Pdp_red,3},
115: {"dp_red_mod",Pdp_red_mod,4},
1.8 noro 116:
117: /* normal form */
1.1 noro 118: {"dp_nf",Pdp_nf,4},
1.16 noro 119: {"dp_nf_f",Pdp_nf_f,4},
1.1 noro 120: {"dp_true_nf",Pdp_true_nf,4},
121: {"dp_nf_mod",Pdp_nf_mod,5},
122: {"dp_true_nf_mod",Pdp_true_nf_mod,5},
1.8 noro 123: {"dp_lnf_mod",Pdp_lnf_mod,3},
1.28 noro 124: {"dp_nf_tab_f",Pdp_nf_tab_f,2},
1.8 noro 125: {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
1.16 noro 126: {"dp_lnf_f",Pdp_lnf_f,2},
1.8 noro 127:
128: /* Buchberger algorithm */
1.1 noro 129: {"dp_gr_main",Pdp_gr_main,5},
130: {"dp_gr_mod_main",Pdp_gr_mod_main,5},
1.27 noro 131: {"dp_gr_f_main",Pdp_gr_f_main,4},
1.23 noro 132: {"dp_gr_checklist",Pdp_gr_checklist,2},
1.33 ! noro 133: {"nd_gr",Pnd_gr,4},
1.8 noro 134:
135: /* F4 algorithm */
1.1 noro 136: {"dp_f4_main",Pdp_f4_main,3},
137: {"dp_f4_mod_main",Pdp_f4_mod_main,4},
1.8 noro 138:
1.11 noro 139: /* weyl algebra */
1.12 noro 140: /* multiplication */
141: {"dp_weyl_mul",Pdp_weyl_mul,2},
1.13 noro 142: {"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3},
1.12 noro 143:
1.11 noro 144: /* s-poly */
145: {"dp_weyl_sp",Pdp_weyl_sp,2},
146:
147: /* m-reduction */
148: {"dp_weyl_red",Pdp_weyl_red,3},
149:
150: /* normal form */
151: {"dp_weyl_nf",Pdp_weyl_nf,4},
1.13 noro 152: {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},
1.16 noro 153: {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},
1.11 noro 154:
155: /* Buchberger algorithm */
156: {"dp_weyl_gr_main",Pdp_weyl_gr_main,5},
157: {"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},
1.16 noro 158: {"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4},
1.11 noro 159:
160: /* F4 algorithm */
161: {"dp_weyl_f4_main",Pdp_weyl_f4_main,3},
1.19 noro 162: {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},
1.11 noro 163:
1.15 noro 164: /* misc */
1.24 noro 165: {"dp_set_weight",Pdp_set_weight,-1},
1.15 noro 166: {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1},
1.8 noro 167: {0,0,0},
168: };
169:
170: struct ftab dp_supp_tab[] = {
171: /* setting flags */
172: {"dp_ord",Pdp_ord,-1},
173: {"dp_set_kara",Pdp_set_kara,-1},
174: {"dp_nelim",Pdp_nelim,-1},
1.1 noro 175: {"dp_gr_flags",Pdp_gr_flags,-1},
176: {"dp_gr_print",Pdp_gr_print,-1},
1.8 noro 177:
178: /* converters */
179: {"dp_ptod",Pdp_ptod,2},
180: {"dp_dtop",Pdp_dtop,2},
181: {"dp_homo",Pdp_homo,1},
182: {"dp_dehomo",Pdp_dehomo,1},
183: {"dp_etov",Pdp_etov,1},
184: {"dp_vtoe",Pdp_vtoe,1},
185: {"dp_dtov",Pdp_dtov,1},
186: {"dp_mdtod",Pdp_mdtod,1},
187: {"dp_mod",Pdp_mod,3},
188: {"dp_rat",Pdp_rat,1},
189:
190: /* criteria */
191: {"dp_cri1",Pdp_cri1,2},
192: {"dp_cri2",Pdp_cri2,2},
193: {"dp_criB",Pdp_criB,3},
194:
195: /* simple operation */
196: {"dp_subd",Pdp_subd,2},
197: {"dp_lcm",Pdp_lcm,2},
198: {"dp_hm",Pdp_hm,1},
199: {"dp_ht",Pdp_ht,1},
200: {"dp_hc",Pdp_hc,1},
201: {"dp_rest",Pdp_rest,1},
202:
203: /* degree and size */
204: {"dp_td",Pdp_td,1},
205: {"dp_mag",Pdp_mag,1},
206: {"dp_sugar",Pdp_sugar,1},
1.30 ohara 207: {"dp_set_sugar",Pdp_set_sugar,2},
1.8 noro 208:
209: /* misc */
210: {"dp_mbase",Pdp_mbase,1},
211: {"dp_redble",Pdp_redble,2},
212: {"dp_sep",Pdp_sep,2},
213: {"dp_idiv",Pdp_idiv,2},
214: {"dp_tdiv",Pdp_tdiv,2},
215: {"dp_minp",Pdp_minp,2},
216:
217: {0,0,0}
1.1 noro 218: };
219:
1.8 noro 220: void Pdp_mdtod(arg,rp)
221: NODE arg;
222: DP *rp;
223: {
224: MP m,mr,mr0;
225: DP p;
226: P t;
227:
228: p = (DP)ARG0(arg);
229: if ( !p )
230: *rp = 0;
231: else {
232: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
233: mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
234: }
235: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
236: }
237: }
238:
239: void Pdp_sep(arg,rp)
240: NODE arg;
241: VECT *rp;
242: {
243: DP p,r;
244: MP m,t;
245: MP *w0,*w;
246: int i,n,d,nv,sugar;
247: VECT v;
248: pointer *pv;
249:
250: p = (DP)ARG0(arg); m = BDY(p);
251: d = QTOS((Q)ARG1(arg));
252: for ( t = m, n = 0; t; t = NEXT(t), n++ );
253: if ( d > n )
254: d = n;
255: MKVECT(v,d); *rp = v;
256: pv = BDY(v); nv = p->nv; sugar = p->sugar;
257: w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
258: w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
259: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) {
260: NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
261: }
262: for ( i = 0; i < d; i++ ) {
263: NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
264: pv[i] = (pointer)r;
265: }
266: }
267:
268: void Pdp_idiv(arg,rp)
269: NODE arg;
270: DP *rp;
271: {
272: dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp);
273: }
274:
275: void Pdp_cont(arg,rp)
276: NODE arg;
277: Q *rp;
278: {
279: dp_cont((DP)ARG0(arg),rp);
280: }
281:
282: void Pdp_dtov(arg,rp)
283: NODE arg;
284: VECT *rp;
285: {
286: dp_dtov((DP)ARG0(arg),rp);
287: }
288:
289: void Pdp_mbase(arg,rp)
290: NODE arg;
291: LIST *rp;
292: {
293: NODE mb;
294:
295: asir_assert(ARG0(arg),O_LIST,"dp_mbase");
296: dp_mbase(BDY((LIST)ARG0(arg)),&mb);
297: MKLIST(*rp,mb);
298: }
299:
300: void Pdp_etov(arg,rp)
301: NODE arg;
302: VECT *rp;
303: {
304: DP dp;
305: int n,i;
306: int *d;
307: VECT v;
308: Q t;
309:
310: dp = (DP)ARG0(arg);
311: asir_assert(dp,O_DP,"dp_etov");
312: n = dp->nv; d = BDY(dp)->dl->d;
313: MKVECT(v,n);
314: for ( i = 0; i < n; i++ ) {
315: STOQ(d[i],t); v->body[i] = (pointer)t;
316: }
317: *rp = v;
318: }
319:
320: void Pdp_vtoe(arg,rp)
321: NODE arg;
322: DP *rp;
323: {
324: DP dp;
325: DL dl;
326: MP m;
327: int n,i,td;
328: int *d;
329: VECT v;
330:
331: v = (VECT)ARG0(arg);
332: asir_assert(v,O_VECT,"dp_vtoe");
333: n = v->len;
334: NEWDL(dl,n); d = dl->d;
335: for ( i = 0, td = 0; i < n; i++ ) {
1.24 noro 336: d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i);
1.8 noro 337: }
338: dl->td = td;
339: NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;
340: MKDP(n,m,dp); dp->sugar = td;
341: *rp = dp;
342: }
343:
344: void Pdp_lnf_mod(arg,rp)
345: NODE arg;
346: LIST *rp;
347: {
348: DP r1,r2;
349: NODE b,g,n;
350: int mod;
351:
352: asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
353: asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
354: asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
355: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
356: mod = QTOS((Q)ARG2(arg));
357: dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
358: NEWNODE(n); BDY(n) = (pointer)r1;
359: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
360: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
361: }
362:
1.16 noro 363: void Pdp_lnf_f(arg,rp)
364: NODE arg;
365: LIST *rp;
366: {
367: DP r1,r2;
368: NODE b,g,n;
369:
370: asir_assert(ARG0(arg),O_LIST,"dp_lnf_f");
371: asir_assert(ARG1(arg),O_LIST,"dp_lnf_f");
372: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
373: dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2);
374: NEWNODE(n); BDY(n) = (pointer)r1;
375: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
376: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
377: }
378:
1.8 noro 379: void Pdp_nf_tab_mod(arg,rp)
380: NODE arg;
381: DP *rp;
382: {
383: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
384: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
385: asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
386: dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
387: QTOS((Q)ARG2(arg)),rp);
1.28 noro 388: }
389:
390: void Pdp_nf_tab_f(arg,rp)
391: NODE arg;
392: DP *rp;
393: {
394: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f");
395: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f");
396: dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp);
1.8 noro 397: }
1.1 noro 398:
399: void Pdp_ord(arg,rp)
400: NODE arg;
401: Obj *rp;
402: {
403: struct order_spec spec;
404:
405: if ( !arg )
406: *rp = dp_current_spec.obj;
407: else if ( !create_order_spec((Obj)ARG0(arg),&spec) )
408: error("dp_ord : invalid order specification");
409: else {
410: initd(&spec); *rp = spec.obj;
411: }
412: }
413:
414: void Pdp_ptod(arg,rp)
415: NODE arg;
416: DP *rp;
417: {
418: NODE n;
419: VL vl,tvl;
420:
421: asir_assert(ARG0(arg),O_P,"dp_ptod");
422: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
423: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
424: if ( !vl ) {
425: NEWVL(vl); tvl = vl;
426: } else {
427: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
428: }
429: VR(tvl) = VR((P)BDY(n));
430: }
431: if ( vl )
432: NEXT(tvl) = 0;
433: ptod(CO,vl,(P)ARG0(arg),rp);
434: }
435:
436: void Pdp_dtop(arg,rp)
437: NODE arg;
438: P *rp;
439: {
440: NODE n;
441: VL vl,tvl;
442:
443: asir_assert(ARG0(arg),O_DP,"dp_dtop");
444: asir_assert(ARG1(arg),O_LIST,"dp_dtop");
445: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
446: if ( !vl ) {
447: NEWVL(vl); tvl = vl;
448: } else {
449: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
450: }
451: VR(tvl) = VR((P)BDY(n));
452: }
453: if ( vl )
454: NEXT(tvl) = 0;
455: dtop(CO,vl,(DP)ARG0(arg),rp);
456: }
457:
458: extern LIST Dist;
459:
460: void Pdp_ptozp(arg,rp)
461: NODE arg;
462: DP *rp;
463: {
464: asir_assert(ARG0(arg),O_DP,"dp_ptozp");
1.10 noro 465: dp_ptozp((DP)ARG0(arg),rp);
1.1 noro 466: }
467:
468: void Pdp_ptozp2(arg,rp)
469: NODE arg;
470: LIST *rp;
471: {
472: DP p0,p1,h,r;
473: NODE n0;
474:
475: p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
476: asir_assert(p0,O_DP,"dp_ptozp2");
477: asir_assert(p1,O_DP,"dp_ptozp2");
1.10 noro 478: dp_ptozp2(p0,p1,&h,&r);
1.1 noro 479: NEWNODE(n0); BDY(n0) = (pointer)h;
480: NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
481: NEXT(NEXT(n0)) = 0;
482: MKLIST(*rp,n0);
483: }
484:
485: void Pdp_prim(arg,rp)
486: NODE arg;
487: DP *rp;
488: {
489: DP t;
490:
491: asir_assert(ARG0(arg),O_DP,"dp_prim");
492: dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
493: }
494:
495: void Pdp_mod(arg,rp)
496: NODE arg;
497: DP *rp;
498: {
499: DP p;
500: int mod;
501: NODE subst;
502:
503: asir_assert(ARG0(arg),O_DP,"dp_mod");
504: asir_assert(ARG1(arg),O_N,"dp_mod");
505: asir_assert(ARG2(arg),O_LIST,"dp_mod");
506: p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
507: subst = BDY((LIST)ARG2(arg));
508: dp_mod(p,mod,subst,rp);
509: }
510:
511: void Pdp_rat(arg,rp)
512: NODE arg;
513: DP *rp;
514: {
515: asir_assert(ARG0(arg),O_DP,"dp_rat");
516: dp_rat((DP)ARG0(arg),rp);
517: }
518:
1.9 noro 519: extern int DP_Multiple;
520:
1.1 noro 521: void Pdp_nf(arg,rp)
522: NODE arg;
523: DP *rp;
524: {
525: NODE b;
526: DP *ps;
527: DP g;
528: int full;
529:
1.11 noro 530: do_weyl = 0;
1.1 noro 531: asir_assert(ARG0(arg),O_LIST,"dp_nf");
532: asir_assert(ARG1(arg),O_DP,"dp_nf");
533: asir_assert(ARG2(arg),O_VECT,"dp_nf");
534: asir_assert(ARG3(arg),O_N,"dp_nf");
535: if ( !(g = (DP)ARG1(arg)) ) {
536: *rp = 0; return;
537: }
538: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
539: full = (Q)ARG3(arg) ? 1 : 0;
1.16 noro 540: dp_nf_z(b,g,ps,full,DP_Multiple,rp);
1.1 noro 541: }
542:
1.11 noro 543: void Pdp_weyl_nf(arg,rp)
544: NODE arg;
545: DP *rp;
546: {
547: NODE b;
548: DP *ps;
549: DP g;
550: int full;
551:
552: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");
553: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");
554: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");
555: asir_assert(ARG3(arg),O_N,"dp_weyl_nf");
556: if ( !(g = (DP)ARG1(arg)) ) {
557: *rp = 0; return;
558: }
559: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
560: full = (Q)ARG3(arg) ? 1 : 0;
1.12 noro 561: do_weyl = 1;
1.16 noro 562: dp_nf_z(b,g,ps,full,DP_Multiple,rp);
563: do_weyl = 0;
564: }
565:
566: /* nf computation using field operations */
567:
568: void Pdp_nf_f(arg,rp)
569: NODE arg;
570: DP *rp;
571: {
572: NODE b;
573: DP *ps;
574: DP g;
575: int full;
576:
577: do_weyl = 0;
578: asir_assert(ARG0(arg),O_LIST,"dp_nf_f");
579: asir_assert(ARG1(arg),O_DP,"dp_nf_f");
580: asir_assert(ARG2(arg),O_VECT,"dp_nf_f");
581: asir_assert(ARG3(arg),O_N,"dp_nf_f");
582: if ( !(g = (DP)ARG1(arg)) ) {
583: *rp = 0; return;
584: }
585: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
586: full = (Q)ARG3(arg) ? 1 : 0;
587: dp_nf_f(b,g,ps,full,rp);
588: }
589:
590: void Pdp_weyl_nf_f(arg,rp)
591: NODE arg;
592: DP *rp;
593: {
594: NODE b;
595: DP *ps;
596: DP g;
597: int full;
598:
599: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f");
600: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f");
601: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f");
602: asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f");
603: if ( !(g = (DP)ARG1(arg)) ) {
604: *rp = 0; return;
605: }
606: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
607: full = (Q)ARG3(arg) ? 1 : 0;
608: do_weyl = 1;
609: dp_nf_f(b,g,ps,full,rp);
1.12 noro 610: do_weyl = 0;
1.11 noro 611: }
612:
1.13 noro 613: void Pdp_nf_mod(arg,rp)
614: NODE arg;
615: DP *rp;
616: {
617: NODE b;
618: DP g;
619: DP *ps;
620: int mod,full,ac;
621: NODE n,n0;
622:
1.14 noro 623: do_weyl = 0;
1.13 noro 624: ac = argc(arg);
1.14 noro 625: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
626: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
627: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
628: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
629: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
1.13 noro 630: if ( !(g = (DP)ARG1(arg)) ) {
631: *rp = 0; return;
632: }
633: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
634: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
635: for ( n0 = n = 0; b; b = NEXT(b) ) {
636: NEXTNODE(n0,n);
637: BDY(n) = (pointer)QTOS((Q)BDY(b));
638: }
639: if ( n0 )
640: NEXT(n) = 0;
641: dp_nf_mod(n0,g,ps,mod,full,rp);
642: }
643:
1.1 noro 644: void Pdp_true_nf(arg,rp)
645: NODE arg;
646: LIST *rp;
647: {
648: NODE b,n;
649: DP *ps;
650: DP g;
651: DP nm;
652: P dn;
653: int full;
654:
1.11 noro 655: do_weyl = 0;
1.1 noro 656: asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
657: asir_assert(ARG1(arg),O_DP,"dp_true_nf");
658: asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
659: asir_assert(ARG3(arg),O_N,"dp_nf");
660: if ( !(g = (DP)ARG1(arg)) ) {
661: nm = 0; dn = (P)ONE;
662: } else {
663: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
664: full = (Q)ARG3(arg) ? 1 : 0;
665: dp_true_nf(b,g,ps,full,&nm,&dn);
666: }
667: NEWNODE(n); BDY(n) = (pointer)nm;
668: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
669: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
670: }
671:
1.13 noro 672: void Pdp_weyl_nf_mod(arg,rp)
1.8 noro 673: NODE arg;
674: DP *rp;
675: {
676: NODE b;
677: DP g;
678: DP *ps;
679: int mod,full,ac;
1.9 noro 680: NODE n,n0;
1.8 noro 681:
682: ac = argc(arg);
1.14 noro 683: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod");
684: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod");
685: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod");
686: asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod");
687: asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod");
1.8 noro 688: if ( !(g = (DP)ARG1(arg)) ) {
689: *rp = 0; return;
690: }
691: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
692: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
1.9 noro 693: for ( n0 = n = 0; b; b = NEXT(b) ) {
694: NEXTNODE(n0,n);
695: BDY(n) = (pointer)QTOS((Q)BDY(b));
696: }
697: if ( n0 )
698: NEXT(n) = 0;
1.13 noro 699: do_weyl = 1;
700: dp_nf_mod(n0,g,ps,mod,full,rp);
701: do_weyl = 0;
1.8 noro 702: }
703:
704: void Pdp_true_nf_mod(arg,rp)
705: NODE arg;
706: LIST *rp;
707: {
708: NODE b;
709: DP g,nm;
710: P dn;
711: DP *ps;
712: int mod,full;
713: NODE n;
714:
1.11 noro 715: do_weyl = 0;
1.8 noro 716: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
717: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
718: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
719: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
720: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
721: if ( !(g = (DP)ARG1(arg)) ) {
722: nm = 0; dn = (P)ONEM;
723: } else {
724: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
725: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
726: dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
727: }
728: NEWNODE(n); BDY(n) = (pointer)nm;
729: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
730: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1.1 noro 731: }
732:
733: void Pdp_tdiv(arg,rp)
734: NODE arg;
735: DP *rp;
736: {
737: MP m,mr,mr0;
738: DP p;
739: Q c;
740: N d,q,r;
741: int sgn;
742:
743: asir_assert(ARG0(arg),O_DP,"dp_tdiv");
744: asir_assert(ARG1(arg),O_N,"dp_tdiv");
745: p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
746: if ( !p )
747: *rp = 0;
748: else {
749: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
750: divn(NM((Q)m->c),d,&q,&r);
751: if ( r ) {
752: *rp = 0; return;
753: } else {
754: NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
755: mr->c = (P)c; mr->dl = m->dl;
756: }
757: }
758: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
759: }
760: }
761:
762: void Pdp_red_coef(arg,rp)
763: NODE arg;
764: DP *rp;
765: {
766: MP m,mr,mr0;
767: P q,r;
768: DP p;
769: P mod;
770:
771: p = (DP)ARG0(arg); mod = (P)ARG1(arg);
772: asir_assert(p,O_DP,"dp_red_coef");
773: asir_assert(mod,O_P,"dp_red_coef");
774: if ( !p )
775: *rp = 0;
776: else {
777: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
778: divsrp(CO,m->c,mod,&q,&r);
779: if ( r ) {
780: NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
781: }
782: }
783: if ( mr0 ) {
784: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
785: } else
786: *rp = 0;
787: }
788: }
789:
790: void Pdp_redble(arg,rp)
791: NODE arg;
792: Q *rp;
793: {
794: asir_assert(ARG0(arg),O_DP,"dp_redble");
795: asir_assert(ARG1(arg),O_DP,"dp_redble");
796: if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
797: *rp = ONE;
798: else
799: *rp = 0;
800: }
801:
802: void Pdp_red_mod(arg,rp)
803: NODE arg;
804: LIST *rp;
805: {
806: DP h,r;
807: P dmy;
808: NODE n;
809:
1.11 noro 810: do_weyl = 0;
1.1 noro 811: asir_assert(ARG0(arg),O_DP,"dp_red_mod");
812: asir_assert(ARG1(arg),O_DP,"dp_red_mod");
813: asir_assert(ARG2(arg),O_DP,"dp_red_mod");
814: asir_assert(ARG3(arg),O_N,"dp_red_mod");
815: dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
816: &h,&r,&dmy);
817: NEWNODE(n); BDY(n) = (pointer)h;
818: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
819: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
820: }
1.13 noro 821:
1.1 noro 822: void Pdp_subd(arg,rp)
823: NODE arg;
824: DP *rp;
825: {
826: DP p1,p2;
827:
828: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
829: asir_assert(p1,O_DP,"dp_subd");
830: asir_assert(p2,O_DP,"dp_subd");
831: dp_subd(p1,p2,rp);
832: }
833:
1.32 noro 834: void Pdp_mul_trunc(arg,rp)
835: NODE arg;
836: DP *rp;
837: {
838: DP p1,p2,p;
839:
840: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg);
841: asir_assert(p1,O_DP,"dp_mul_trunc");
842: asir_assert(p2,O_DP,"dp_mul_trunc");
843: asir_assert(p,O_DP,"dp_mul_trunc");
844: comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp);
845: }
846:
847: void Pdp_quo(arg,rp)
848: NODE arg;
849: DP *rp;
850: {
851: DP p1,p2;
852:
853: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
854: asir_assert(p1,O_DP,"dp_quo");
855: asir_assert(p2,O_DP,"dp_quo");
856: comm_quod(CO,p1,p2,rp);
857: }
858:
1.12 noro 859: void Pdp_weyl_mul(arg,rp)
860: NODE arg;
861: DP *rp;
862: {
863: DP p1,p2;
864:
865: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1.32 noro 866: asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul");
1.12 noro 867: do_weyl = 1;
868: muld(CO,p1,p2,rp);
1.13 noro 869: do_weyl = 0;
870: }
871:
872: void Pdp_weyl_mul_mod(arg,rp)
873: NODE arg;
874: DP *rp;
875: {
876: DP p1,p2;
877: Q m;
878:
879: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg);
880: asir_assert(p1,O_DP,"dp_weyl_mul_mod");
881: asir_assert(p2,O_DP,"dp_mul_mod");
882: asir_assert(m,O_N,"dp_mul_mod");
883: do_weyl = 1;
884: mulmd(CO,QTOS(m),p1,p2,rp);
1.12 noro 885: do_weyl = 0;
886: }
887:
1.1 noro 888: void Pdp_red(arg,rp)
889: NODE arg;
890: LIST *rp;
891: {
892: NODE n;
1.4 noro 893: DP head,rest,dmy1;
1.1 noro 894: P dmy;
895:
1.11 noro 896: do_weyl = 0;
1.1 noro 897: asir_assert(ARG0(arg),O_DP,"dp_red");
898: asir_assert(ARG1(arg),O_DP,"dp_red");
899: asir_assert(ARG2(arg),O_DP,"dp_red");
1.4 noro 900: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1 noro 901: NEWNODE(n); BDY(n) = (pointer)head;
902: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
903: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
904: }
905:
1.11 noro 906: void Pdp_weyl_red(arg,rp)
907: NODE arg;
908: LIST *rp;
909: {
910: NODE n;
911: DP head,rest,dmy1;
912: P dmy;
913:
914: asir_assert(ARG0(arg),O_DP,"dp_weyl_red");
915: asir_assert(ARG1(arg),O_DP,"dp_weyl_red");
916: asir_assert(ARG2(arg),O_DP,"dp_weyl_red");
1.12 noro 917: do_weyl = 1;
1.11 noro 918: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.12 noro 919: do_weyl = 0;
1.11 noro 920: NEWNODE(n); BDY(n) = (pointer)head;
921: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
922: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
923: }
924:
1.1 noro 925: void Pdp_sp(arg,rp)
926: NODE arg;
927: DP *rp;
928: {
929: DP p1,p2;
930:
1.11 noro 931: do_weyl = 0;
1.1 noro 932: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
933: asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
934: dp_sp(p1,p2,rp);
935: }
936:
1.11 noro 937: void Pdp_weyl_sp(arg,rp)
938: NODE arg;
939: DP *rp;
940: {
941: DP p1,p2;
942:
943: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
944: asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");
1.12 noro 945: do_weyl = 1;
1.11 noro 946: dp_sp(p1,p2,rp);
1.12 noro 947: do_weyl = 0;
1.11 noro 948: }
949:
1.1 noro 950: void Pdp_sp_mod(arg,rp)
951: NODE arg;
952: DP *rp;
953: {
954: DP p1,p2;
955: int mod;
956:
1.11 noro 957: do_weyl = 0;
1.1 noro 958: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
959: asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
960: asir_assert(ARG2(arg),O_N,"dp_sp_mod");
961: mod = QTOS((Q)ARG2(arg));
962: dp_sp_mod(p1,p2,mod,rp);
963: }
964:
965: void Pdp_lcm(arg,rp)
966: NODE arg;
967: DP *rp;
968: {
969: int i,n,td;
970: DL d1,d2,d;
971: MP m;
972: DP p1,p2;
973:
974: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
975: asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
976: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
977: NEWDL(d,n);
978: for ( i = 0, td = 0; i < n; i++ ) {
1.24 noro 979: d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i);
1.1 noro 980: }
981: d->td = td;
982: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
983: MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */
984: }
985:
986: void Pdp_hm(arg,rp)
987: NODE arg;
988: DP *rp;
989: {
990: DP p;
991:
992: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
993: dp_hm(p,rp);
994: }
995:
996: void Pdp_ht(arg,rp)
997: NODE arg;
998: DP *rp;
999: {
1000: DP p;
1001: MP m,mr;
1002:
1003: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
1004: if ( !p )
1005: *rp = 0;
1006: else {
1007: m = BDY(p);
1008: NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0;
1009: MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */
1010: }
1011: }
1012:
1013: void Pdp_hc(arg,rp)
1014: NODE arg;
1015: P *rp;
1016: {
1017: asir_assert(ARG0(arg),O_DP,"dp_hc");
1018: if ( !ARG0(arg) )
1019: *rp = 0;
1020: else
1021: *rp = BDY((DP)ARG0(arg))->c;
1022: }
1023:
1024: void Pdp_rest(arg,rp)
1025: NODE arg;
1026: DP *rp;
1027: {
1028: asir_assert(ARG0(arg),O_DP,"dp_rest");
1029: if ( !ARG0(arg) )
1030: *rp = 0;
1031: else
1032: dp_rest((DP)ARG0(arg),rp);
1033: }
1034:
1035: void Pdp_td(arg,rp)
1036: NODE arg;
1037: Q *rp;
1038: {
1039: DP p;
1040:
1041: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
1042: if ( !p )
1043: *rp = 0;
1044: else
1045: STOQ(BDY(p)->dl->td,*rp);
1046: }
1047:
1048: void Pdp_sugar(arg,rp)
1049: NODE arg;
1050: Q *rp;
1051: {
1052: DP p;
1053:
1054: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
1055: if ( !p )
1056: *rp = 0;
1057: else
1058: STOQ(p->sugar,*rp);
1.30 ohara 1059: }
1060:
1061: void Pdp_set_sugar(arg,rp)
1062: NODE arg;
1063: Q *rp;
1064: {
1065: DP p;
1066: Q q;
1067: int i;
1068:
1069: p = (DP)ARG0(arg);
1070: q = (Q)ARG1(arg);
1071: if ( p && q) {
1072: asir_assert(p,O_DP,"dp_set_sugar");
1073: asir_assert(q,O_N, "dp_set_sugar");
1074: i = QTOS(q);
1075: if (p->sugar < i) {
1076: p->sugar = i;
1077: }
1078: }
1079: *rp = 0;
1.1 noro 1080: }
1081:
1082: void Pdp_cri1(arg,rp)
1083: NODE arg;
1084: Q *rp;
1085: {
1086: DP p1,p2;
1087: int *d1,*d2;
1088: int i,n;
1089:
1090: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1091: asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
1092: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
1093: for ( i = 0; i < n; i++ )
1094: if ( d1[i] > d2[i] )
1095: break;
1096: *rp = i == n ? ONE : 0;
1097: }
1098:
1099: void Pdp_cri2(arg,rp)
1100: NODE arg;
1101: Q *rp;
1102: {
1103: DP p1,p2;
1104: int *d1,*d2;
1105: int i,n;
1106:
1107: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1108: asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
1109: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
1110: for ( i = 0; i < n; i++ )
1111: if ( MIN(d1[i],d2[i]) >= 1 )
1112: break;
1113: *rp = i == n ? ONE : 0;
1114: }
1115:
1116: void Pdp_minp(arg,rp)
1117: NODE arg;
1118: LIST *rp;
1119: {
1120: NODE tn,tn1,d,dd,dd0,p,tp;
1121: LIST l,minp;
1122: DP lcm,tlcm;
1123: int s,ts;
1124:
1125: asir_assert(ARG0(arg),O_LIST,"dp_minp");
1126: d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
1127: p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
1128: if ( !ARG1(arg) ) {
1129: s = QTOS((Q)BDY(p)); p = NEXT(p);
1130: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
1131: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
1132: tlcm = (DP)BDY(tp); tp = NEXT(tp);
1133: ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
1134: NEXTNODE(dd0,dd);
1135: if ( ts < s ) {
1136: BDY(dd) = (pointer)minp;
1137: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
1138: } else if ( ts == s ) {
1139: if ( compd(CO,lcm,tlcm) > 0 ) {
1140: BDY(dd) = (pointer)minp;
1141: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
1142: } else
1143: BDY(dd) = BDY(d);
1144: } else
1145: BDY(dd) = BDY(d);
1146: }
1147: } else {
1148: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
1149: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
1150: tlcm = (DP)BDY(tp);
1151: NEXTNODE(dd0,dd);
1152: if ( compd(CO,lcm,tlcm) > 0 ) {
1153: BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
1154: } else
1155: BDY(dd) = BDY(d);
1156: }
1157: }
1158: if ( dd0 )
1159: NEXT(dd) = 0;
1160: MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
1161: }
1162:
1163: void Pdp_criB(arg,rp)
1164: NODE arg;
1165: LIST *rp;
1166: {
1167: NODE d,ij,dd,ddd;
1168: int i,j,s,n;
1169: DP *ps;
1170: DL ts,ti,tj,lij,tdl;
1171:
1172: asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
1173: asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
1174: asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
1175: if ( !d )
1176: *rp = (LIST)ARG0(arg);
1177: else {
1178: ts = BDY(ps[s])->dl;
1179: n = ps[s]->nv;
1180: NEWDL(tdl,n);
1181: for ( dd = 0; d; d = NEXT(d) ) {
1182: ij = BDY((LIST)BDY(d));
1183: i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
1184: j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
1185: lij = BDY((DP)BDY(ij))->dl;
1186: ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
1187: if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
1188: || !dl_equal(n,lij,tdl)
1189: || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
1190: && dl_equal(n,tdl,lij))
1191: || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
1192: && dl_equal(n,tdl,lij)) ) {
1193: MKNODE(ddd,BDY(d),dd);
1194: dd = ddd;
1195: }
1196: }
1197: MKLIST(*rp,dd);
1198: }
1199: }
1200:
1201: void Pdp_nelim(arg,rp)
1202: NODE arg;
1203: Q *rp;
1204: {
1205: if ( arg ) {
1206: asir_assert(ARG0(arg),O_N,"dp_nelim");
1207: dp_nelim = QTOS((Q)ARG0(arg));
1208: }
1209: STOQ(dp_nelim,*rp);
1210: }
1211:
1212: void Pdp_mag(arg,rp)
1213: NODE arg;
1214: Q *rp;
1215: {
1216: DP p;
1217: int s;
1218: MP m;
1219:
1220: p = (DP)ARG0(arg);
1221: asir_assert(p,O_DP,"dp_mag");
1222: if ( !p )
1223: *rp = 0;
1224: else {
1225: for ( s = 0, m = BDY(p); m; m = NEXT(m) )
1226: s += p_mag(m->c);
1227: STOQ(s,*rp);
1228: }
1229: }
1230:
1231: extern int kara_mag;
1232:
1233: void Pdp_set_kara(arg,rp)
1234: NODE arg;
1235: Q *rp;
1236: {
1237: if ( arg ) {
1238: asir_assert(ARG0(arg),O_N,"dp_set_kara");
1239: kara_mag = QTOS((Q)ARG0(arg));
1240: }
1241: STOQ(kara_mag,*rp);
1242: }
1243:
1244: void Pdp_homo(arg,rp)
1245: NODE arg;
1246: DP *rp;
1247: {
1248: asir_assert(ARG0(arg),O_DP,"dp_homo");
1249: dp_homo((DP)ARG0(arg),rp);
1250: }
1251:
1.8 noro 1252: void Pdp_dehomo(arg,rp)
1253: NODE arg;
1.1 noro 1254: DP *rp;
1255: {
1.8 noro 1256: asir_assert(ARG0(arg),O_DP,"dp_dehomo");
1257: dp_dehomo((DP)ARG0(arg),rp);
1258: }
1259:
1260: void Pdp_gr_flags(arg,rp)
1261: NODE arg;
1262: LIST *rp;
1263: {
1264: Obj name,value;
1265: NODE n;
1.1 noro 1266:
1.8 noro 1267: if ( arg ) {
1268: asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
1269: n = BDY((LIST)ARG0(arg));
1270: while ( n ) {
1271: name = (Obj)BDY(n); n = NEXT(n);
1272: if ( !n )
1273: break;
1274: else {
1275: value = (Obj)BDY(n); n = NEXT(n);
1276: }
1277: dp_set_flag(name,value);
1.1 noro 1278: }
1279: }
1.8 noro 1280: dp_make_flaglist(rp);
1281: }
1282:
1.29 noro 1283: extern int DP_Print, DP_PrintShort;
1.8 noro 1284:
1285: void Pdp_gr_print(arg,rp)
1286: NODE arg;
1287: Q *rp;
1288: {
1289: Q q;
1.29 noro 1290: int s;
1.8 noro 1291:
1292: if ( arg ) {
1293: asir_assert(ARG0(arg),O_N,"dp_gr_print");
1.29 noro 1294: q = (Q)ARG0(arg);
1295: s = QTOS(q);
1296: switch ( s ) {
1297: case 0:
1298: DP_Print = 0; DP_PrintShort = 0;
1299: break;
1300: case 1:
1301: DP_Print = 1;
1302: break;
1303: case 2: default:
1304: DP_Print = 0; DP_PrintShort = 1;
1305: break;
1306: }
1307: } else {
1308: if ( DP_Print ) {
1309: STOQ(1,q);
1310: } else if ( DP_PrintShort ) {
1311: STOQ(2,q);
1312: } else
1313: q = 0;
1314: }
1.8 noro 1315: *rp = q;
1.1 noro 1316: }
1317:
1.8 noro 1318: void Pdp_gr_main(arg,rp)
1.1 noro 1319: NODE arg;
1.8 noro 1320: LIST *rp;
1.1 noro 1321: {
1.8 noro 1322: LIST f,v;
1323: Num homo;
1324: Q m;
1325: int modular;
1326: struct order_spec ord;
1327:
1.11 noro 1328: do_weyl = 0;
1.8 noro 1329: asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
1330: asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
1331: asir_assert(ARG2(arg),O_N,"dp_gr_main");
1332: asir_assert(ARG3(arg),O_N,"dp_gr_main");
1333: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1334: f = remove_zero_from_list(f);
1335: if ( !BDY(f) ) {
1336: *rp = f; return;
1337: }
1.8 noro 1338: homo = (Num)ARG2(arg);
1339: m = (Q)ARG3(arg);
1340: if ( !m )
1341: modular = 0;
1342: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
1343: error("dp_gr_main : too large modulus");
1344: else
1345: modular = QTOS(m);
1346: create_order_spec(ARG4(arg),&ord);
1.16 noro 1347: dp_gr_main(f,v,homo,modular,0,&ord,rp);
1348: }
1349:
1350: void Pdp_gr_f_main(arg,rp)
1351: NODE arg;
1352: LIST *rp;
1353: {
1354: LIST f,v;
1355: Num homo;
1.26 noro 1356: int m,field,t;
1.16 noro 1357: struct order_spec ord;
1.26 noro 1358: NODE n;
1.16 noro 1359:
1360: do_weyl = 0;
1361: asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main");
1362: asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main");
1363: asir_assert(ARG2(arg),O_N,"dp_gr_f_main");
1364: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1365: f = remove_zero_from_list(f);
1366: if ( !BDY(f) ) {
1367: *rp = f; return;
1368: }
1.16 noro 1369: homo = (Num)ARG2(arg);
1.27 noro 1370: #if 0
1371: asir_assert(ARG3(arg),O_N,"dp_gr_f_main");
1.26 noro 1372: m = QTOS((Q)ARG3(arg));
1373: if ( m )
1374: error("dp_gr_f_main : trace lifting is not implemented yet");
1375: create_order_spec(ARG4(arg),&ord);
1.27 noro 1376: #else
1377: m = 0;
1378: create_order_spec(ARG3(arg),&ord);
1379: #endif
1.26 noro 1380: field = 0;
1381: for ( n = BDY(f); n; n = NEXT(n) ) {
1382: t = get_field_type(BDY(n));
1383: if ( !t )
1384: continue;
1385: if ( t < 0 )
1386: error("dp_gr_f_main : incosistent coefficients");
1387: if ( !field )
1388: field = t;
1389: else if ( t != field )
1390: error("dp_gr_f_main : incosistent coefficients");
1391: }
1392: dp_gr_main(f,v,homo,m?1:0,field,&ord,rp);
1.1 noro 1393: }
1394:
1.8 noro 1395: void Pdp_f4_main(arg,rp)
1396: NODE arg;
1397: LIST *rp;
1.1 noro 1398: {
1.8 noro 1399: LIST f,v;
1400: struct order_spec ord;
1.1 noro 1401:
1.11 noro 1402: do_weyl = 0;
1.8 noro 1403: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
1404: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
1405: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1406: f = remove_zero_from_list(f);
1407: if ( !BDY(f) ) {
1408: *rp = f; return;
1409: }
1.8 noro 1410: create_order_spec(ARG2(arg),&ord);
1.17 noro 1411: dp_f4_main(f,v,&ord,rp);
1.22 noro 1412: }
1413:
1414: /* dp_gr_checklist(list of dp) */
1415:
1416: void Pdp_gr_checklist(arg,rp)
1417: NODE arg;
1418: LIST *rp;
1419: {
1420: VECT g;
1421: LIST dp;
1422: NODE r;
1.23 noro 1423: int n;
1.22 noro 1424:
1425: do_weyl = 0;
1426: asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist");
1.23 noro 1427: asir_assert(ARG1(arg),O_N,"dp_gr_checklist");
1428: n = QTOS((Q)ARG1(arg));
1429: gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp);
1.22 noro 1430: r = mknode(2,g,dp);
1431: MKLIST(*rp,r);
1.1 noro 1432: }
1433:
1.8 noro 1434: void Pdp_f4_mod_main(arg,rp)
1435: NODE arg;
1436: LIST *rp;
1.1 noro 1437: {
1.8 noro 1438: LIST f,v;
1439: int m;
1440: struct order_spec ord;
1441:
1.11 noro 1442: do_weyl = 0;
1.17 noro 1443: asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main");
1444: asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main");
1445: asir_assert(ARG2(arg),O_N,"dp_f4_mod_main");
1.8 noro 1446: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1.25 noro 1447: f = remove_zero_from_list(f);
1448: if ( !BDY(f) ) {
1449: *rp = f; return;
1450: }
1.20 noro 1451: if ( !m )
1452: error("dp_f4_mod_main : invalid argument");
1.8 noro 1453: create_order_spec(ARG3(arg),&ord);
1454: dp_f4_mod_main(f,v,m,&ord,rp);
1455: }
1.1 noro 1456:
1.8 noro 1457: void Pdp_gr_mod_main(arg,rp)
1458: NODE arg;
1459: LIST *rp;
1460: {
1461: LIST f,v;
1462: Num homo;
1463: int m;
1464: struct order_spec ord;
1465:
1.11 noro 1466: do_weyl = 0;
1.8 noro 1467: asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
1468: asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
1469: asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
1470: asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
1.11 noro 1471: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1472: f = remove_zero_from_list(f);
1473: if ( !BDY(f) ) {
1474: *rp = f; return;
1475: }
1.11 noro 1476: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1.20 noro 1477: if ( !m )
1478: error("dp_gr_mod_main : invalid argument");
1.11 noro 1479: create_order_spec(ARG4(arg),&ord);
1480: dp_gr_mod_main(f,v,homo,m,&ord,rp);
1.33 ! noro 1481: }
! 1482:
! 1483: void Pnd_gr(arg,rp)
! 1484: NODE arg;
! 1485: LIST *rp;
! 1486: {
! 1487: LIST f,v;
! 1488: int m;
! 1489: struct order_spec ord;
! 1490:
! 1491: do_weyl = 0;
! 1492: asir_assert(ARG0(arg),O_LIST,"nd_gr");
! 1493: asir_assert(ARG1(arg),O_LIST,"nd_gr");
! 1494: asir_assert(ARG3(arg),O_N,"nd_gr");
! 1495: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1496: f = remove_zero_from_list(f);
! 1497: if ( !BDY(f) ) {
! 1498: *rp = f; return;
! 1499: }
! 1500: m = QTOS((Q)ARG2(arg));
! 1501: if ( !m )
! 1502: error("nd_gr : invalid argument");
! 1503: create_order_spec(ARG3(arg),&ord);
! 1504: nd_gr(f,v,m,&ord,rp);
1.11 noro 1505: }
1506:
1507: /* for Weyl algebra */
1508:
1509: void Pdp_weyl_gr_main(arg,rp)
1510: NODE arg;
1511: LIST *rp;
1512: {
1513: LIST f,v;
1514: Num homo;
1515: Q m;
1516: int modular;
1517: struct order_spec ord;
1518:
1519: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
1520: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
1521: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
1522: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
1523: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1524: f = remove_zero_from_list(f);
1525: if ( !BDY(f) ) {
1526: *rp = f; return;
1527: }
1.11 noro 1528: homo = (Num)ARG2(arg);
1529: m = (Q)ARG3(arg);
1530: if ( !m )
1531: modular = 0;
1532: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
1533: error("dp_gr_main : too large modulus");
1534: else
1535: modular = QTOS(m);
1536: create_order_spec(ARG4(arg),&ord);
1.12 noro 1537: do_weyl = 1;
1.16 noro 1538: dp_gr_main(f,v,homo,modular,0,&ord,rp);
1539: do_weyl = 0;
1540: }
1541:
1542: void Pdp_weyl_gr_f_main(arg,rp)
1543: NODE arg;
1544: LIST *rp;
1545: {
1546: LIST f,v;
1547: Num homo;
1548: struct order_spec ord;
1549:
1550: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
1551: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
1552: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
1553: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
1554: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1555: f = remove_zero_from_list(f);
1556: if ( !BDY(f) ) {
1557: *rp = f; return;
1558: }
1.16 noro 1559: homo = (Num)ARG2(arg);
1560: create_order_spec(ARG3(arg),&ord);
1561: do_weyl = 1;
1562: dp_gr_main(f,v,homo,0,1,&ord,rp);
1.12 noro 1563: do_weyl = 0;
1.11 noro 1564: }
1565:
1566: void Pdp_weyl_f4_main(arg,rp)
1567: NODE arg;
1568: LIST *rp;
1569: {
1570: LIST f,v;
1571: struct order_spec ord;
1572:
1573: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
1574: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
1575: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1576: f = remove_zero_from_list(f);
1577: if ( !BDY(f) ) {
1578: *rp = f; return;
1579: }
1.11 noro 1580: create_order_spec(ARG2(arg),&ord);
1.12 noro 1581: do_weyl = 1;
1.17 noro 1582: dp_f4_main(f,v,&ord,rp);
1.12 noro 1583: do_weyl = 0;
1.11 noro 1584: }
1585:
1586: void Pdp_weyl_f4_mod_main(arg,rp)
1587: NODE arg;
1588: LIST *rp;
1589: {
1590: LIST f,v;
1591: int m;
1592: struct order_spec ord;
1593:
1594: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
1595: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
1596: asir_assert(ARG2(arg),O_N,"dp_f4_main");
1597: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1.25 noro 1598: f = remove_zero_from_list(f);
1599: if ( !BDY(f) ) {
1600: *rp = f; return;
1601: }
1.20 noro 1602: if ( !m )
1603: error("dp_weyl_f4_mod_main : invalid argument");
1.11 noro 1604: create_order_spec(ARG3(arg),&ord);
1.12 noro 1605: do_weyl = 1;
1.11 noro 1606: dp_f4_mod_main(f,v,m,&ord,rp);
1.12 noro 1607: do_weyl = 0;
1.11 noro 1608: }
1609:
1610: void Pdp_weyl_gr_mod_main(arg,rp)
1611: NODE arg;
1612: LIST *rp;
1613: {
1614: LIST f,v;
1615: Num homo;
1616: int m;
1617: struct order_spec ord;
1618:
1619: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");
1620: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");
1621: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");
1622: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");
1.8 noro 1623: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1624: f = remove_zero_from_list(f);
1625: if ( !BDY(f) ) {
1626: *rp = f; return;
1627: }
1.8 noro 1628: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1.20 noro 1629: if ( !m )
1630: error("dp_weyl_gr_mod_main : invalid argument");
1.8 noro 1631: create_order_spec(ARG4(arg),&ord);
1.12 noro 1632: do_weyl = 1;
1.8 noro 1633: dp_gr_mod_main(f,v,homo,m,&ord,rp);
1.12 noro 1634: do_weyl = 0;
1.1 noro 1635: }
1.8 noro 1636:
1.24 noro 1637: static VECT current_dl_weight_vector_obj;
1638: int *current_dl_weight_vector;
1639:
1640: void Pdp_set_weight(arg,rp)
1641: NODE arg;
1642: VECT *rp;
1643: {
1644: VECT v;
1645: int i,n;
1646:
1647: if ( !arg )
1648: *rp = current_dl_weight_vector_obj;
1649: else if ( !ARG0(arg) ) {
1650: current_dl_weight_vector_obj = 0;
1651: current_dl_weight_vector = 0;
1652: *rp = 0;
1653: } else {
1654: asir_assert(ARG0(arg),O_VECT,"dp_set_weight");
1655: v = (VECT)ARG0(arg);
1656: current_dl_weight_vector_obj = v;
1657: n = v->len;
1658: current_dl_weight_vector = (int *)CALLOC(n,sizeof(int));
1659: for ( i = 0; i < n; i++ )
1660: current_dl_weight_vector[i] = QTOS((Q)v->body[i]);
1661: *rp = v;
1662: }
1663: }
1664:
1665: static VECT current_weyl_weight_vector_obj;
1666: int *current_weyl_weight_vector;
1.15 noro 1667:
1668: void Pdp_weyl_set_weight(arg,rp)
1669: NODE arg;
1670: VECT *rp;
1671: {
1672: VECT v;
1673: int i,n;
1674:
1675: if ( !arg )
1.24 noro 1676: *rp = current_weyl_weight_vector_obj;
1.15 noro 1677: else {
1678: asir_assert(ARG0(arg),O_VECT,"dp_weyl_set_weight");
1679: v = (VECT)ARG0(arg);
1.24 noro 1680: current_weyl_weight_vector_obj = v;
1.15 noro 1681: n = v->len;
1.24 noro 1682: current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int));
1.15 noro 1683: for ( i = 0; i < n; i++ )
1.24 noro 1684: current_weyl_weight_vector[i] = QTOS((Q)v->body[i]);
1.15 noro 1685: *rp = v;
1686: }
1.25 noro 1687: }
1688:
1689: LIST remove_zero_from_list(LIST l)
1690: {
1691: NODE n,r0,r;
1692: LIST rl;
1693:
1694: asir_assert(l,O_LIST,"remove_zero_from_list");
1695: n = BDY(l);
1696: for ( r0 = 0; n; n = NEXT(n) )
1697: if ( BDY(n) ) {
1698: NEXTNODE(r0,r);
1699: BDY(r) = BDY(n);
1700: }
1701: if ( r0 )
1702: NEXT(r) = 0;
1703: MKLIST(rl,r0);
1704: return rl;
1.26 noro 1705: }
1706:
1707: int get_field_type(P p)
1708: {
1709: int type,t;
1710: DCP dc;
1711:
1712: if ( !p )
1713: return 0;
1714: else if ( NUM(p) )
1715: return NID((Num)p);
1716: else {
1717: type = 0;
1718: for ( dc = DC(p); dc; dc = NEXT(dc) ) {
1719: t = get_field_type(COEF(dc));
1720: if ( !t )
1721: continue;
1722: if ( t < 0 )
1723: return t;
1724: if ( !type )
1725: type = t;
1726: else if ( t != type )
1727: return -1;
1728: }
1729: return type;
1730: }
1.15 noro 1731: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dp.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin