Annotation of OpenXM_contrib2/asir2000/builtin/dp.c, Revision 1.11
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.11 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.10 2000/12/08 06:43:09 noro Exp $
1.5 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "base.h"
52: #include "parse.h"
53:
54: extern int dp_fcoeffs;
1.8 noro 55: extern int dp_nelim;
56: extern int dp_order_pair_length;
57: extern struct order_pair *dp_order_pair;
58: extern struct order_spec dp_current_spec;
59:
1.11 ! noro 60: int do_weyl;
1.1 noro 61:
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();
65: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
66: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
1.9 noro 67: void Pdp_nf(),Pdp_true_nf();
1.1 noro 68: void Pdp_nf_mod(),Pdp_true_nf_mod();
69: void Pdp_criB(),Pdp_nelim();
1.9 noro 70: void Pdp_minp(),Pdp_sp_mod();
1.1 noro 71: void Pdp_homo(),Pdp_dehomo();
72: void Pdp_gr_mod_main();
73: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
74: void Pdp_f4_main(),Pdp_f4_mod_main();
75: void Pdp_gr_print();
1.8 noro 76: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod();
77: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
78: void Pdp_cont();
1.1 noro 79:
1.11 ! noro 80: void Pdp_weyl_red(),Pdp_weyl_sp(),Pdp_weyl_nf();
! 81: void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main();
! 82: void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main();
! 83:
1.1 noro 84: struct ftab dp_tab[] = {
1.8 noro 85: /* content reduction */
1.1 noro 86: {"dp_ptozp",Pdp_ptozp,1},
87: {"dp_ptozp2",Pdp_ptozp2,2},
88: {"dp_prim",Pdp_prim,1},
1.8 noro 89: {"dp_red_coef",Pdp_red_coef,2},
90: {"dp_cont",Pdp_cont,1},
91:
1.11 ! noro 92: /* polynomial ring */
1.8 noro 93: /* s-poly */
94: {"dp_sp",Pdp_sp,2},
95: {"dp_sp_mod",Pdp_sp_mod,3},
96:
97: /* m-reduction */
1.1 noro 98: {"dp_red",Pdp_red,3},
99: {"dp_red_mod",Pdp_red_mod,4},
1.8 noro 100:
101: /* normal form */
1.1 noro 102: {"dp_nf",Pdp_nf,4},
103: {"dp_true_nf",Pdp_true_nf,4},
104: {"dp_nf_mod",Pdp_nf_mod,5},
105: {"dp_true_nf_mod",Pdp_true_nf_mod,5},
1.8 noro 106: {"dp_lnf_mod",Pdp_lnf_mod,3},
107: {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
108:
109: /* Buchberger algorithm */
1.1 noro 110: {"dp_gr_main",Pdp_gr_main,5},
111: {"dp_gr_mod_main",Pdp_gr_mod_main,5},
1.8 noro 112:
113: /* F4 algorithm */
1.1 noro 114: {"dp_f4_main",Pdp_f4_main,3},
115: {"dp_f4_mod_main",Pdp_f4_mod_main,4},
1.8 noro 116:
1.11 ! noro 117: /* weyl algebra */
! 118: /* s-poly */
! 119: {"dp_weyl_sp",Pdp_weyl_sp,2},
! 120:
! 121: /* m-reduction */
! 122: {"dp_weyl_red",Pdp_weyl_red,3},
! 123:
! 124: /* normal form */
! 125: {"dp_weyl_nf",Pdp_weyl_nf,4},
! 126:
! 127: /* Buchberger algorithm */
! 128: {"dp_weyl_gr_main",Pdp_weyl_gr_main,5},
! 129: {"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},
! 130:
! 131: /* F4 algorithm */
! 132: {"dp_weyl_f4_main",Pdp_weyl_f4_main,3},
! 133: {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},
! 134:
1.8 noro 135: {0,0,0},
136: };
137:
138: struct ftab dp_supp_tab[] = {
139: /* setting flags */
140: {"dp_ord",Pdp_ord,-1},
141: {"dp_set_kara",Pdp_set_kara,-1},
142: {"dp_nelim",Pdp_nelim,-1},
1.1 noro 143: {"dp_gr_flags",Pdp_gr_flags,-1},
144: {"dp_gr_print",Pdp_gr_print,-1},
1.8 noro 145:
146: /* converters */
147: {"dp_ptod",Pdp_ptod,2},
148: {"dp_dtop",Pdp_dtop,2},
149: {"dp_homo",Pdp_homo,1},
150: {"dp_dehomo",Pdp_dehomo,1},
151: {"dp_etov",Pdp_etov,1},
152: {"dp_vtoe",Pdp_vtoe,1},
153: {"dp_dtov",Pdp_dtov,1},
154: {"dp_mdtod",Pdp_mdtod,1},
155: {"dp_mod",Pdp_mod,3},
156: {"dp_rat",Pdp_rat,1},
157:
158: /* criteria */
159: {"dp_cri1",Pdp_cri1,2},
160: {"dp_cri2",Pdp_cri2,2},
161: {"dp_criB",Pdp_criB,3},
162:
163: /* simple operation */
164: {"dp_subd",Pdp_subd,2},
165: {"dp_lcm",Pdp_lcm,2},
166: {"dp_hm",Pdp_hm,1},
167: {"dp_ht",Pdp_ht,1},
168: {"dp_hc",Pdp_hc,1},
169: {"dp_rest",Pdp_rest,1},
170:
171: /* degree and size */
172: {"dp_td",Pdp_td,1},
173: {"dp_mag",Pdp_mag,1},
174: {"dp_sugar",Pdp_sugar,1},
175:
176: /* misc */
177: {"dp_mbase",Pdp_mbase,1},
178: {"dp_redble",Pdp_redble,2},
179: {"dp_sep",Pdp_sep,2},
180: {"dp_idiv",Pdp_idiv,2},
181: {"dp_tdiv",Pdp_tdiv,2},
182: {"dp_minp",Pdp_minp,2},
183:
184: {0,0,0}
1.1 noro 185: };
186:
1.8 noro 187: void Pdp_mdtod(arg,rp)
188: NODE arg;
189: DP *rp;
190: {
191: MP m,mr,mr0;
192: DP p;
193: P t;
194:
195: p = (DP)ARG0(arg);
196: if ( !p )
197: *rp = 0;
198: else {
199: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
200: mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
201: }
202: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
203: }
204: }
205:
206: void Pdp_sep(arg,rp)
207: NODE arg;
208: VECT *rp;
209: {
210: DP p,r;
211: MP m,t;
212: MP *w0,*w;
213: int i,n,d,nv,sugar;
214: VECT v;
215: pointer *pv;
216:
217: p = (DP)ARG0(arg); m = BDY(p);
218: d = QTOS((Q)ARG1(arg));
219: for ( t = m, n = 0; t; t = NEXT(t), n++ );
220: if ( d > n )
221: d = n;
222: MKVECT(v,d); *rp = v;
223: pv = BDY(v); nv = p->nv; sugar = p->sugar;
224: w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
225: w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
226: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) {
227: NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
228: }
229: for ( i = 0; i < d; i++ ) {
230: NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
231: pv[i] = (pointer)r;
232: }
233: }
234:
235: void Pdp_idiv(arg,rp)
236: NODE arg;
237: DP *rp;
238: {
239: dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp);
240: }
241:
242: void Pdp_cont(arg,rp)
243: NODE arg;
244: Q *rp;
245: {
246: dp_cont((DP)ARG0(arg),rp);
247: }
248:
249: void Pdp_dtov(arg,rp)
250: NODE arg;
251: VECT *rp;
252: {
253: dp_dtov((DP)ARG0(arg),rp);
254: }
255:
256: void Pdp_mbase(arg,rp)
257: NODE arg;
258: LIST *rp;
259: {
260: NODE mb;
261:
262: asir_assert(ARG0(arg),O_LIST,"dp_mbase");
263: dp_mbase(BDY((LIST)ARG0(arg)),&mb);
264: MKLIST(*rp,mb);
265: }
266:
267: void Pdp_etov(arg,rp)
268: NODE arg;
269: VECT *rp;
270: {
271: DP dp;
272: int n,i;
273: int *d;
274: VECT v;
275: Q t;
276:
277: dp = (DP)ARG0(arg);
278: asir_assert(dp,O_DP,"dp_etov");
279: n = dp->nv; d = BDY(dp)->dl->d;
280: MKVECT(v,n);
281: for ( i = 0; i < n; i++ ) {
282: STOQ(d[i],t); v->body[i] = (pointer)t;
283: }
284: *rp = v;
285: }
286:
287: void Pdp_vtoe(arg,rp)
288: NODE arg;
289: DP *rp;
290: {
291: DP dp;
292: DL dl;
293: MP m;
294: int n,i,td;
295: int *d;
296: VECT v;
297:
298: v = (VECT)ARG0(arg);
299: asir_assert(v,O_VECT,"dp_vtoe");
300: n = v->len;
301: NEWDL(dl,n); d = dl->d;
302: for ( i = 0, td = 0; i < n; i++ ) {
303: d[i] = QTOS((Q)(v->body[i])); td += d[i];
304: }
305: dl->td = td;
306: NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;
307: MKDP(n,m,dp); dp->sugar = td;
308: *rp = dp;
309: }
310:
311: void Pdp_lnf_mod(arg,rp)
312: NODE arg;
313: LIST *rp;
314: {
315: DP r1,r2;
316: NODE b,g,n;
317: int mod;
318:
319: asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
320: asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
321: asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
322: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
323: mod = QTOS((Q)ARG2(arg));
324: dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
325: NEWNODE(n); BDY(n) = (pointer)r1;
326: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
327: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
328: }
329:
330: void Pdp_nf_tab_mod(arg,rp)
331: NODE arg;
332: DP *rp;
333: {
334: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
335: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
336: asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
337: dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
338: QTOS((Q)ARG2(arg)),rp);
339: }
1.1 noro 340:
341: void Pdp_ord(arg,rp)
342: NODE arg;
343: Obj *rp;
344: {
345: struct order_spec spec;
346:
347: if ( !arg )
348: *rp = dp_current_spec.obj;
349: else if ( !create_order_spec((Obj)ARG0(arg),&spec) )
350: error("dp_ord : invalid order specification");
351: else {
352: initd(&spec); *rp = spec.obj;
353: }
354: }
355:
356: void Pdp_ptod(arg,rp)
357: NODE arg;
358: DP *rp;
359: {
360: NODE n;
361: VL vl,tvl;
362:
363: asir_assert(ARG0(arg),O_P,"dp_ptod");
364: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
365: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
366: if ( !vl ) {
367: NEWVL(vl); tvl = vl;
368: } else {
369: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
370: }
371: VR(tvl) = VR((P)BDY(n));
372: }
373: if ( vl )
374: NEXT(tvl) = 0;
375: ptod(CO,vl,(P)ARG0(arg),rp);
376: }
377:
378: void Pdp_dtop(arg,rp)
379: NODE arg;
380: P *rp;
381: {
382: NODE n;
383: VL vl,tvl;
384:
385: asir_assert(ARG0(arg),O_DP,"dp_dtop");
386: asir_assert(ARG1(arg),O_LIST,"dp_dtop");
387: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
388: if ( !vl ) {
389: NEWVL(vl); tvl = vl;
390: } else {
391: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
392: }
393: VR(tvl) = VR((P)BDY(n));
394: }
395: if ( vl )
396: NEXT(tvl) = 0;
397: dtop(CO,vl,(DP)ARG0(arg),rp);
398: }
399:
400: extern LIST Dist;
401:
402: void Pdp_ptozp(arg,rp)
403: NODE arg;
404: DP *rp;
405: {
406: asir_assert(ARG0(arg),O_DP,"dp_ptozp");
1.10 noro 407: dp_ptozp((DP)ARG0(arg),rp);
1.1 noro 408: }
409:
410: void Pdp_ptozp2(arg,rp)
411: NODE arg;
412: LIST *rp;
413: {
414: DP p0,p1,h,r;
415: NODE n0;
416:
417: p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
418: asir_assert(p0,O_DP,"dp_ptozp2");
419: asir_assert(p1,O_DP,"dp_ptozp2");
1.10 noro 420: dp_ptozp2(p0,p1,&h,&r);
1.1 noro 421: NEWNODE(n0); BDY(n0) = (pointer)h;
422: NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
423: NEXT(NEXT(n0)) = 0;
424: MKLIST(*rp,n0);
425: }
426:
427: void Pdp_prim(arg,rp)
428: NODE arg;
429: DP *rp;
430: {
431: DP t;
432:
433: asir_assert(ARG0(arg),O_DP,"dp_prim");
434: dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
435: }
436:
437: void Pdp_mod(arg,rp)
438: NODE arg;
439: DP *rp;
440: {
441: DP p;
442: int mod;
443: NODE subst;
444:
445: asir_assert(ARG0(arg),O_DP,"dp_mod");
446: asir_assert(ARG1(arg),O_N,"dp_mod");
447: asir_assert(ARG2(arg),O_LIST,"dp_mod");
448: p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
449: subst = BDY((LIST)ARG2(arg));
450: dp_mod(p,mod,subst,rp);
451: }
452:
453: void Pdp_rat(arg,rp)
454: NODE arg;
455: DP *rp;
456: {
457: asir_assert(ARG0(arg),O_DP,"dp_rat");
458: dp_rat((DP)ARG0(arg),rp);
459: }
460:
1.9 noro 461: extern int DP_Multiple;
462:
1.1 noro 463: void Pdp_nf(arg,rp)
464: NODE arg;
465: DP *rp;
466: {
467: NODE b;
468: DP *ps;
469: DP g;
470: int full;
471:
1.11 ! noro 472: do_weyl = 0;
1.1 noro 473: asir_assert(ARG0(arg),O_LIST,"dp_nf");
474: asir_assert(ARG1(arg),O_DP,"dp_nf");
475: asir_assert(ARG2(arg),O_VECT,"dp_nf");
476: asir_assert(ARG3(arg),O_N,"dp_nf");
477: if ( !(g = (DP)ARG1(arg)) ) {
478: *rp = 0; return;
479: }
480: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
481: full = (Q)ARG3(arg) ? 1 : 0;
1.9 noro 482: dp_nf_ptozp(b,g,ps,full,DP_Multiple,rp);
1.1 noro 483: }
484:
1.11 ! noro 485: void Pdp_weyl_nf(arg,rp)
! 486: NODE arg;
! 487: DP *rp;
! 488: {
! 489: NODE b;
! 490: DP *ps;
! 491: DP g;
! 492: int full;
! 493:
! 494: do_weyl = 1;
! 495: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");
! 496: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");
! 497: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");
! 498: asir_assert(ARG3(arg),O_N,"dp_weyl_nf");
! 499: if ( !(g = (DP)ARG1(arg)) ) {
! 500: *rp = 0; return;
! 501: }
! 502: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
! 503: full = (Q)ARG3(arg) ? 1 : 0;
! 504: dp_nf_ptozp(b,g,ps,full,DP_Multiple,rp);
! 505: }
! 506:
1.1 noro 507: void Pdp_true_nf(arg,rp)
508: NODE arg;
509: LIST *rp;
510: {
511: NODE b,n;
512: DP *ps;
513: DP g;
514: DP nm;
515: P dn;
516: int full;
517:
1.11 ! noro 518: do_weyl = 0;
1.1 noro 519: asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
520: asir_assert(ARG1(arg),O_DP,"dp_true_nf");
521: asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
522: asir_assert(ARG3(arg),O_N,"dp_nf");
523: if ( !(g = (DP)ARG1(arg)) ) {
524: nm = 0; dn = (P)ONE;
525: } else {
526: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
527: full = (Q)ARG3(arg) ? 1 : 0;
528: dp_true_nf(b,g,ps,full,&nm,&dn);
529: }
530: NEWNODE(n); BDY(n) = (pointer)nm;
531: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
532: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
533: }
534:
1.8 noro 535: void Pdp_nf_mod(arg,rp)
536: NODE arg;
537: DP *rp;
538: {
539: NODE b;
540: DP g;
541: DP *ps;
542: int mod,full,ac;
1.9 noro 543: NODE n,n0;
1.8 noro 544:
1.11 ! noro 545: do_weyl = 0;
1.8 noro 546: ac = argc(arg);
547: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
548: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
549: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
550: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
551: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
552: if ( !(g = (DP)ARG1(arg)) ) {
553: *rp = 0; return;
554: }
555: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
556: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
1.9 noro 557: for ( n0 = n = 0; b; b = NEXT(b) ) {
558: NEXTNODE(n0,n);
559: BDY(n) = (pointer)QTOS((Q)BDY(b));
560: }
561: if ( n0 )
562: NEXT(n) = 0;
563: dp_nf_mod(n,g,ps,mod,full,rp);
1.8 noro 564: }
565:
566: void Pdp_true_nf_mod(arg,rp)
567: NODE arg;
568: LIST *rp;
569: {
570: NODE b;
571: DP g,nm;
572: P dn;
573: DP *ps;
574: int mod,full;
575: NODE n;
576:
1.11 ! noro 577: do_weyl = 0;
1.8 noro 578: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
579: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
580: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
581: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
582: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
583: if ( !(g = (DP)ARG1(arg)) ) {
584: nm = 0; dn = (P)ONEM;
585: } else {
586: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
587: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
588: dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
589: }
590: NEWNODE(n); BDY(n) = (pointer)nm;
591: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
592: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1.1 noro 593: }
594:
595: void Pdp_tdiv(arg,rp)
596: NODE arg;
597: DP *rp;
598: {
599: MP m,mr,mr0;
600: DP p;
601: Q c;
602: N d,q,r;
603: int sgn;
604:
605: asir_assert(ARG0(arg),O_DP,"dp_tdiv");
606: asir_assert(ARG1(arg),O_N,"dp_tdiv");
607: p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
608: if ( !p )
609: *rp = 0;
610: else {
611: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
612: divn(NM((Q)m->c),d,&q,&r);
613: if ( r ) {
614: *rp = 0; return;
615: } else {
616: NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
617: mr->c = (P)c; mr->dl = m->dl;
618: }
619: }
620: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
621: }
622: }
623:
624: void Pdp_red_coef(arg,rp)
625: NODE arg;
626: DP *rp;
627: {
628: MP m,mr,mr0;
629: P q,r;
630: DP p;
631: P mod;
632:
633: p = (DP)ARG0(arg); mod = (P)ARG1(arg);
634: asir_assert(p,O_DP,"dp_red_coef");
635: asir_assert(mod,O_P,"dp_red_coef");
636: if ( !p )
637: *rp = 0;
638: else {
639: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
640: divsrp(CO,m->c,mod,&q,&r);
641: if ( r ) {
642: NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
643: }
644: }
645: if ( mr0 ) {
646: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
647: } else
648: *rp = 0;
649: }
650: }
651:
652: void Pdp_redble(arg,rp)
653: NODE arg;
654: Q *rp;
655: {
656: asir_assert(ARG0(arg),O_DP,"dp_redble");
657: asir_assert(ARG1(arg),O_DP,"dp_redble");
658: if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
659: *rp = ONE;
660: else
661: *rp = 0;
662: }
663:
664: void Pdp_red_mod(arg,rp)
665: NODE arg;
666: LIST *rp;
667: {
668: DP h,r;
669: P dmy;
670: NODE n;
671:
1.11 ! noro 672: do_weyl = 0;
1.1 noro 673: asir_assert(ARG0(arg),O_DP,"dp_red_mod");
674: asir_assert(ARG1(arg),O_DP,"dp_red_mod");
675: asir_assert(ARG2(arg),O_DP,"dp_red_mod");
676: asir_assert(ARG3(arg),O_N,"dp_red_mod");
677: dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
678: &h,&r,&dmy);
679: NEWNODE(n); BDY(n) = (pointer)h;
680: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
681: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
682: }
683: void Pdp_subd(arg,rp)
684: NODE arg;
685: DP *rp;
686: {
687: DP p1,p2;
688:
689: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
690: asir_assert(p1,O_DP,"dp_subd");
691: asir_assert(p2,O_DP,"dp_subd");
692: dp_subd(p1,p2,rp);
693: }
694:
695: void Pdp_red(arg,rp)
696: NODE arg;
697: LIST *rp;
698: {
699: NODE n;
1.4 noro 700: DP head,rest,dmy1;
1.1 noro 701: P dmy;
702:
1.11 ! noro 703: do_weyl = 0;
1.1 noro 704: asir_assert(ARG0(arg),O_DP,"dp_red");
705: asir_assert(ARG1(arg),O_DP,"dp_red");
706: asir_assert(ARG2(arg),O_DP,"dp_red");
1.4 noro 707: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1 noro 708: NEWNODE(n); BDY(n) = (pointer)head;
709: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
710: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
711: }
712:
1.11 ! noro 713: void Pdp_weyl_red(arg,rp)
! 714: NODE arg;
! 715: LIST *rp;
! 716: {
! 717: NODE n;
! 718: DP head,rest,dmy1;
! 719: P dmy;
! 720:
! 721: do_weyl = 1;
! 722: asir_assert(ARG0(arg),O_DP,"dp_weyl_red");
! 723: asir_assert(ARG1(arg),O_DP,"dp_weyl_red");
! 724: asir_assert(ARG2(arg),O_DP,"dp_weyl_red");
! 725: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
! 726: NEWNODE(n); BDY(n) = (pointer)head;
! 727: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
! 728: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
! 729: }
! 730:
1.1 noro 731: void Pdp_sp(arg,rp)
732: NODE arg;
733: DP *rp;
734: {
735: DP p1,p2;
736:
1.11 ! noro 737: do_weyl = 0;
1.1 noro 738: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
739: asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
740: dp_sp(p1,p2,rp);
741: }
742:
1.11 ! noro 743: void Pdp_weyl_sp(arg,rp)
! 744: NODE arg;
! 745: DP *rp;
! 746: {
! 747: DP p1,p2;
! 748:
! 749: do_weyl = 1;
! 750: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
! 751: asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");
! 752: dp_sp(p1,p2,rp);
! 753: }
! 754:
1.1 noro 755: void Pdp_sp_mod(arg,rp)
756: NODE arg;
757: DP *rp;
758: {
759: DP p1,p2;
760: int mod;
761:
1.11 ! noro 762: do_weyl = 0;
1.1 noro 763: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
764: asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
765: asir_assert(ARG2(arg),O_N,"dp_sp_mod");
766: mod = QTOS((Q)ARG2(arg));
767: dp_sp_mod(p1,p2,mod,rp);
768: }
769:
770: void Pdp_lcm(arg,rp)
771: NODE arg;
772: DP *rp;
773: {
774: int i,n,td;
775: DL d1,d2,d;
776: MP m;
777: DP p1,p2;
778:
779: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
780: asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
781: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
782: NEWDL(d,n);
783: for ( i = 0, td = 0; i < n; i++ ) {
784: d->d[i] = MAX(d1->d[i],d2->d[i]); td += d->d[i];
785: }
786: d->td = td;
787: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
788: MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */
789: }
790:
791: void Pdp_hm(arg,rp)
792: NODE arg;
793: DP *rp;
794: {
795: DP p;
796:
797: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
798: dp_hm(p,rp);
799: }
800:
801: void Pdp_ht(arg,rp)
802: NODE arg;
803: DP *rp;
804: {
805: DP p;
806: MP m,mr;
807:
808: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
809: if ( !p )
810: *rp = 0;
811: else {
812: m = BDY(p);
813: NEWMP(mr); mr->dl = m->dl; mr->c = (P)ONE; NEXT(mr) = 0;
814: MKDP(p->nv,mr,*rp); (*rp)->sugar = mr->dl->td; /* XXX */
815: }
816: }
817:
818: void Pdp_hc(arg,rp)
819: NODE arg;
820: P *rp;
821: {
822: asir_assert(ARG0(arg),O_DP,"dp_hc");
823: if ( !ARG0(arg) )
824: *rp = 0;
825: else
826: *rp = BDY((DP)ARG0(arg))->c;
827: }
828:
829: void Pdp_rest(arg,rp)
830: NODE arg;
831: DP *rp;
832: {
833: asir_assert(ARG0(arg),O_DP,"dp_rest");
834: if ( !ARG0(arg) )
835: *rp = 0;
836: else
837: dp_rest((DP)ARG0(arg),rp);
838: }
839:
840: void Pdp_td(arg,rp)
841: NODE arg;
842: Q *rp;
843: {
844: DP p;
845:
846: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
847: if ( !p )
848: *rp = 0;
849: else
850: STOQ(BDY(p)->dl->td,*rp);
851: }
852:
853: void Pdp_sugar(arg,rp)
854: NODE arg;
855: Q *rp;
856: {
857: DP p;
858:
859: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
860: if ( !p )
861: *rp = 0;
862: else
863: STOQ(p->sugar,*rp);
864: }
865:
866: void Pdp_cri1(arg,rp)
867: NODE arg;
868: Q *rp;
869: {
870: DP p1,p2;
871: int *d1,*d2;
872: int i,n;
873:
874: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
875: asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
876: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
877: for ( i = 0; i < n; i++ )
878: if ( d1[i] > d2[i] )
879: break;
880: *rp = i == n ? ONE : 0;
881: }
882:
883: void Pdp_cri2(arg,rp)
884: NODE arg;
885: Q *rp;
886: {
887: DP p1,p2;
888: int *d1,*d2;
889: int i,n;
890:
891: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
892: asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
893: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
894: for ( i = 0; i < n; i++ )
895: if ( MIN(d1[i],d2[i]) >= 1 )
896: break;
897: *rp = i == n ? ONE : 0;
898: }
899:
900: void Pdp_minp(arg,rp)
901: NODE arg;
902: LIST *rp;
903: {
904: NODE tn,tn1,d,dd,dd0,p,tp;
905: LIST l,minp;
906: DP lcm,tlcm;
907: int s,ts;
908:
909: asir_assert(ARG0(arg),O_LIST,"dp_minp");
910: d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
911: p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
912: if ( !ARG1(arg) ) {
913: s = QTOS((Q)BDY(p)); p = NEXT(p);
914: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
915: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
916: tlcm = (DP)BDY(tp); tp = NEXT(tp);
917: ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
918: NEXTNODE(dd0,dd);
919: if ( ts < s ) {
920: BDY(dd) = (pointer)minp;
921: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
922: } else if ( ts == s ) {
923: if ( compd(CO,lcm,tlcm) > 0 ) {
924: BDY(dd) = (pointer)minp;
925: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
926: } else
927: BDY(dd) = BDY(d);
928: } else
929: BDY(dd) = BDY(d);
930: }
931: } else {
932: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
933: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
934: tlcm = (DP)BDY(tp);
935: NEXTNODE(dd0,dd);
936: if ( compd(CO,lcm,tlcm) > 0 ) {
937: BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
938: } else
939: BDY(dd) = BDY(d);
940: }
941: }
942: if ( dd0 )
943: NEXT(dd) = 0;
944: MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
945: }
946:
947: void Pdp_criB(arg,rp)
948: NODE arg;
949: LIST *rp;
950: {
951: NODE d,ij,dd,ddd;
952: int i,j,s,n;
953: DP *ps;
954: DL ts,ti,tj,lij,tdl;
955:
956: asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
957: asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
958: asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
959: if ( !d )
960: *rp = (LIST)ARG0(arg);
961: else {
962: ts = BDY(ps[s])->dl;
963: n = ps[s]->nv;
964: NEWDL(tdl,n);
965: for ( dd = 0; d; d = NEXT(d) ) {
966: ij = BDY((LIST)BDY(d));
967: i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
968: j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
969: lij = BDY((DP)BDY(ij))->dl;
970: ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
971: if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
972: || !dl_equal(n,lij,tdl)
973: || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
974: && dl_equal(n,tdl,lij))
975: || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
976: && dl_equal(n,tdl,lij)) ) {
977: MKNODE(ddd,BDY(d),dd);
978: dd = ddd;
979: }
980: }
981: MKLIST(*rp,dd);
982: }
983: }
984:
985: void Pdp_nelim(arg,rp)
986: NODE arg;
987: Q *rp;
988: {
989: if ( arg ) {
990: asir_assert(ARG0(arg),O_N,"dp_nelim");
991: dp_nelim = QTOS((Q)ARG0(arg));
992: }
993: STOQ(dp_nelim,*rp);
994: }
995:
996: void Pdp_mag(arg,rp)
997: NODE arg;
998: Q *rp;
999: {
1000: DP p;
1001: int s;
1002: MP m;
1003:
1004: p = (DP)ARG0(arg);
1005: asir_assert(p,O_DP,"dp_mag");
1006: if ( !p )
1007: *rp = 0;
1008: else {
1009: for ( s = 0, m = BDY(p); m; m = NEXT(m) )
1010: s += p_mag(m->c);
1011: STOQ(s,*rp);
1012: }
1013: }
1014:
1015: extern int kara_mag;
1016:
1017: void Pdp_set_kara(arg,rp)
1018: NODE arg;
1019: Q *rp;
1020: {
1021: if ( arg ) {
1022: asir_assert(ARG0(arg),O_N,"dp_set_kara");
1023: kara_mag = QTOS((Q)ARG0(arg));
1024: }
1025: STOQ(kara_mag,*rp);
1026: }
1027:
1028: void Pdp_homo(arg,rp)
1029: NODE arg;
1030: DP *rp;
1031: {
1032: asir_assert(ARG0(arg),O_DP,"dp_homo");
1033: dp_homo((DP)ARG0(arg),rp);
1034: }
1035:
1.8 noro 1036: void Pdp_dehomo(arg,rp)
1037: NODE arg;
1.1 noro 1038: DP *rp;
1039: {
1.8 noro 1040: asir_assert(ARG0(arg),O_DP,"dp_dehomo");
1041: dp_dehomo((DP)ARG0(arg),rp);
1042: }
1043:
1044: void Pdp_gr_flags(arg,rp)
1045: NODE arg;
1046: LIST *rp;
1047: {
1048: Obj name,value;
1049: NODE n;
1.1 noro 1050:
1.8 noro 1051: if ( arg ) {
1052: asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
1053: n = BDY((LIST)ARG0(arg));
1054: while ( n ) {
1055: name = (Obj)BDY(n); n = NEXT(n);
1056: if ( !n )
1057: break;
1058: else {
1059: value = (Obj)BDY(n); n = NEXT(n);
1060: }
1061: dp_set_flag(name,value);
1.1 noro 1062: }
1063: }
1.8 noro 1064: dp_make_flaglist(rp);
1065: }
1066:
1067: extern int DP_Print;
1068:
1069: void Pdp_gr_print(arg,rp)
1070: NODE arg;
1071: Q *rp;
1072: {
1073: Q q;
1074:
1075: if ( arg ) {
1076: asir_assert(ARG0(arg),O_N,"dp_gr_print");
1077: q = (Q)ARG0(arg); DP_Print = QTOS(q);
1078: } else
1079: STOQ(DP_Print,q);
1080: *rp = q;
1.1 noro 1081: }
1082:
1.8 noro 1083: void Pdp_gr_main(arg,rp)
1.1 noro 1084: NODE arg;
1.8 noro 1085: LIST *rp;
1.1 noro 1086: {
1.8 noro 1087: LIST f,v;
1088: Num homo;
1089: Q m;
1090: int modular;
1091: struct order_spec ord;
1092:
1.11 ! noro 1093: do_weyl = 0;
1.8 noro 1094: asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
1095: asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
1096: asir_assert(ARG2(arg),O_N,"dp_gr_main");
1097: asir_assert(ARG3(arg),O_N,"dp_gr_main");
1098: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1099: homo = (Num)ARG2(arg);
1100: m = (Q)ARG3(arg);
1101: if ( !m )
1102: modular = 0;
1103: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
1104: error("dp_gr_main : too large modulus");
1105: else
1106: modular = QTOS(m);
1107: create_order_spec(ARG4(arg),&ord);
1108: dp_gr_main(f,v,homo,modular,&ord,rp);
1.1 noro 1109: }
1110:
1.8 noro 1111: void Pdp_f4_main(arg,rp)
1112: NODE arg;
1113: LIST *rp;
1.1 noro 1114: {
1.8 noro 1115: LIST f,v;
1116: struct order_spec ord;
1.1 noro 1117:
1.11 ! noro 1118: do_weyl = 0;
1.8 noro 1119: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
1120: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
1121: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1122: create_order_spec(ARG2(arg),&ord);
1123: dp_f4_main(f,v,&ord,rp);
1.1 noro 1124: }
1125:
1.8 noro 1126: void Pdp_f4_mod_main(arg,rp)
1127: NODE arg;
1128: LIST *rp;
1.1 noro 1129: {
1.8 noro 1130: LIST f,v;
1131: int m;
1132: struct order_spec ord;
1133:
1.11 ! noro 1134: do_weyl = 0;
1.8 noro 1135: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
1136: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
1137: asir_assert(ARG2(arg),O_N,"dp_f4_main");
1138: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1139: create_order_spec(ARG3(arg),&ord);
1140: dp_f4_mod_main(f,v,m,&ord,rp);
1141: }
1.1 noro 1142:
1.8 noro 1143: void Pdp_gr_mod_main(arg,rp)
1144: NODE arg;
1145: LIST *rp;
1146: {
1147: LIST f,v;
1148: Num homo;
1149: int m;
1150: struct order_spec ord;
1151:
1.11 ! noro 1152: do_weyl = 0;
1.8 noro 1153: asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
1154: asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
1155: asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
1156: asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
1.11 ! noro 1157: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1158: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
! 1159: create_order_spec(ARG4(arg),&ord);
! 1160: dp_gr_mod_main(f,v,homo,m,&ord,rp);
! 1161: }
! 1162:
! 1163: /* for Weyl algebra */
! 1164:
! 1165: void Pdp_weyl_gr_main(arg,rp)
! 1166: NODE arg;
! 1167: LIST *rp;
! 1168: {
! 1169: LIST f,v;
! 1170: Num homo;
! 1171: Q m;
! 1172: int modular;
! 1173: struct order_spec ord;
! 1174:
! 1175: do_weyl = 1;
! 1176: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
! 1177: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
! 1178: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
! 1179: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
! 1180: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1181: homo = (Num)ARG2(arg);
! 1182: m = (Q)ARG3(arg);
! 1183: if ( !m )
! 1184: modular = 0;
! 1185: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
! 1186: error("dp_gr_main : too large modulus");
! 1187: else
! 1188: modular = QTOS(m);
! 1189: create_order_spec(ARG4(arg),&ord);
! 1190: dp_gr_main(f,v,homo,modular,&ord,rp);
! 1191: }
! 1192:
! 1193: void Pdp_weyl_f4_main(arg,rp)
! 1194: NODE arg;
! 1195: LIST *rp;
! 1196: {
! 1197: LIST f,v;
! 1198: struct order_spec ord;
! 1199:
! 1200: do_weyl = 1;
! 1201: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
! 1202: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
! 1203: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
! 1204: create_order_spec(ARG2(arg),&ord);
! 1205: dp_f4_main(f,v,&ord,rp);
! 1206: }
! 1207:
! 1208: void Pdp_weyl_f4_mod_main(arg,rp)
! 1209: NODE arg;
! 1210: LIST *rp;
! 1211: {
! 1212: LIST f,v;
! 1213: int m;
! 1214: struct order_spec ord;
! 1215:
! 1216: do_weyl = 1;
! 1217: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
! 1218: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
! 1219: asir_assert(ARG2(arg),O_N,"dp_f4_main");
! 1220: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
! 1221: create_order_spec(ARG3(arg),&ord);
! 1222: dp_f4_mod_main(f,v,m,&ord,rp);
! 1223: }
! 1224:
! 1225: void Pdp_weyl_gr_mod_main(arg,rp)
! 1226: NODE arg;
! 1227: LIST *rp;
! 1228: {
! 1229: LIST f,v;
! 1230: Num homo;
! 1231: int m;
! 1232: struct order_spec ord;
! 1233:
! 1234: do_weyl = 1;
! 1235: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");
! 1236: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");
! 1237: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");
! 1238: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");
1.8 noro 1239: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1240: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1241: create_order_spec(ARG4(arg),&ord);
1242: dp_gr_mod_main(f,v,homo,m,&ord,rp);
1.1 noro 1243: }
1.8 noro 1244:
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