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