Annotation of OpenXM_contrib2/asir2018/builtin/dp.c, Revision 1.4
1.1 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
26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
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.4 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.3 2018/11/12 04:25:13 noro Exp $
1.1 noro 49: */
50: #include "ca.h"
51: #include "base.h"
52: #include "parse.h"
53:
54: extern int dp_fcoeffs;
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: extern struct modorder_spec *dp_current_modspec;
60: extern int nd_rref2;
61:
62: int do_weyl;
63:
1.3 noro 64: void Pdp_monomial_hilbert_poincare();
1.1 noro 65: void Pdp_sort();
66: void Pdp_mul_trunc(),Pdp_quo();
67: void Pdp_ord(), Pdp_ptod(), Pdp_dtop(), Phomogenize();
68: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
69: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
70: void Pdp_set_sugar();
71: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
72: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
73: void Pdp_nf(),Pdp_true_nf(),Pdp_true_nf_marked(),Pdp_true_nf_marked_mod();
74:
75: void Pdp_true_nf_and_quotient(),Pdp_true_nf_and_quotient_mod();
76: void Pdp_true_nf_and_quotient_marked(),Pdp_true_nf_and_quotient_marked_mod();
77:
78: void Pdp_nf_mod(),Pdp_true_nf_mod();
79: void Pdp_criB(),Pdp_nelim();
80: void Pdp_minp(),Pdp_sp_mod();
81: void Pdp_homo(),Pdp_dehomo();
82: void Pdp_gr_mod_main(),Pdp_gr_f_main();
83: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
84: void Pdp_interreduce();
85: void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main();
86: void Pdp_gr_print();
87: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f();
88: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
89: void Pdp_cont();
90: void Pdp_gr_checklist();
91: void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc();
92: void Pdpm_ltod(),Pdpm_dtol(),Pdpm_ord(),Pdpm_nf(),Pdpm_weyl_nf(),Pdpm_sp(),Pdpm_weyl_sp();
93: void Pdpm_hm(),Pdpm_ht(),Pdpm_hc();
94:
95: void Pdp_weyl_red();
96: void Pdp_weyl_sp();
97:
98: void Pdp_weyl_nf(),Pdp_weyl_nf_mod();
99: void Pdp_weyl_true_nf_and_quotient(),Pdp_weyl_true_nf_and_quotient_mod();
100: void Pdp_weyl_true_nf_and_quotient_marked(),Pdp_weyl_true_nf_and_quotient_marked_mod();
101:
102: void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main();
103: void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main();
104: void Pdp_weyl_mul(),Pdp_weyl_mul_mod(),Pdp_weyl_act();
105: void Pdp_weyl_set_weight();
106: void Pdp_set_weight(),Pdp_set_top_weight(),Pdp_set_module_weight();
107: void Pdp_nf_f(),Pdp_weyl_nf_f();
108: void Pdpm_nf_f(),Pdpm_weyl_nf_f();
109: void Pdp_lnf_f();
110: void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace();
111: void Pnd_gr_postproc(), Pnd_weyl_gr_postproc();
112: void Pnd_gr_recompute_trace(), Pnd_btog();
113: void Pnd_weyl_gr(),Pnd_weyl_gr_trace();
114: void Pnd_nf(),Pnd_weyl_nf();
115: void Pdp_initial_term();
116: void Pdp_order();
117: void Pdp_inv_or_split();
118: void Pdp_compute_last_t();
119: void Pdp_compute_last_w();
120: void Pdp_compute_essential_df();
121: void Pdp_get_denomlist();
122: void Pdp_symb_add();
123: void Pdp_mono_raddec();
124: void Pdp_mono_reduce();
125: void Pdp_rref2(),Psumi_updatepairs(),Psumi_symbolic();
126:
127: LIST dp_initial_term();
128: LIST dp_order();
129: void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo,
130: int *modular,struct order_spec **ord);
131: NODE dp_inv_or_split(NODE gb,DP f,struct order_spec *spec, DP *inv);
132:
133: LIST remove_zero_from_list(LIST);
134:
135: struct ftab dp_tab[] = {
136: /* content reduction */
137: {"dp_ptozp",Pdp_ptozp,1},
138: {"dp_ptozp2",Pdp_ptozp2,2},
139: {"dp_prim",Pdp_prim,1},
140: {"dp_red_coef",Pdp_red_coef,2},
141: {"dp_cont",Pdp_cont,1},
142:
143: /* polynomial ring */
144: /* special operations */
145: {"dp_mul_trunc",Pdp_mul_trunc,3},
146: {"dp_quo",Pdp_quo,2},
147:
148: /* s-poly */
149: {"dp_sp",Pdp_sp,2},
150: {"dp_sp_mod",Pdp_sp_mod,3},
151:
152: /* m-reduction */
153: {"dp_red",Pdp_red,3},
154: {"dp_red_mod",Pdp_red_mod,4},
155:
156: /* normal form */
157: {"dp_nf",Pdp_nf,4},
158: {"dp_nf_mod",Pdp_nf_mod,5},
159: {"dp_nf_f",Pdp_nf_f,4},
160: {"dpm_nf_f",Pdpm_nf_f,4},
161: {"dpm_weyl_nf_f",Pdpm_weyl_nf_f,4},
162: {"dpm_nf",Pdpm_nf,4},
163: {"dpm_sp",Pdpm_sp,2},
164: {"dpm_weyl_sp",Pdpm_weyl_sp,2},
165:
166: {"dp_true_nf",Pdp_true_nf,4},
167: {"dp_true_nf_mod",Pdp_true_nf_mod,5},
168: {"dp_true_nf_marked",Pdp_true_nf_marked,4},
169: {"dp_true_nf_marked_mod",Pdp_true_nf_marked_mod,5},
170:
171: {"dp_true_nf_and_quotient",Pdp_true_nf_and_quotient,3},
172: {"dp_true_nf_and_quotient_mod",Pdp_true_nf_and_quotient_mod,4},
173: {"dp_true_nf_and_quotient_marked",Pdp_true_nf_and_quotient_marked,4},
174: {"dp_true_nf_and_quotient_marked_mod",Pdp_true_nf_and_quotient_marked_mod,5},
175:
176: {"dp_lnf_mod",Pdp_lnf_mod,3},
177: {"dp_nf_tab_f",Pdp_nf_tab_f,2},
178: {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
179: {"dp_lnf_f",Pdp_lnf_f,2},
180:
181: /* Buchberger algorithm */
182: {"dp_gr_main",Pdp_gr_main,-5},
183: {"dp_interreduce",Pdp_interreduce,3},
184: {"dp_gr_mod_main",Pdp_gr_mod_main,5},
185: {"dp_gr_f_main",Pdp_gr_f_main,4},
186: {"dp_gr_checklist",Pdp_gr_checklist,2},
187: {"nd_f4",Pnd_f4,-4},
188: {"nd_gr",Pnd_gr,-4},
189: {"nd_gr_trace",Pnd_gr_trace,-5},
190: {"nd_f4_trace",Pnd_f4_trace,-5},
191: {"nd_gr_postproc",Pnd_gr_postproc,5},
192: {"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5},
193: {"nd_btog",Pnd_btog,-6},
194: {"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5},
195: {"nd_weyl_gr",Pnd_weyl_gr,-4},
196: {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,-5},
197: {"nd_nf",Pnd_nf,5},
198: {"nd_weyl_nf",Pnd_weyl_nf,5},
199:
200: /* F4 algorithm */
201: {"dp_f4_main",Pdp_f4_main,3},
202: {"dp_f4_mod_main",Pdp_f4_mod_main,4},
203:
204: /* weyl algebra */
205: /* multiplication */
206: {"dp_weyl_mul",Pdp_weyl_mul,2},
207: {"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3},
208: {"dp_weyl_act",Pdp_weyl_act,2},
209:
210: /* s-poly */
211: {"dp_weyl_sp",Pdp_weyl_sp,2},
212:
213: /* m-reduction */
214: {"dp_weyl_red",Pdp_weyl_red,3},
215:
216: /* normal form */
217: {"dp_weyl_nf",Pdp_weyl_nf,4},
218: {"dpm_weyl_nf",Pdpm_weyl_nf,4},
219: {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},
220: {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},
221:
222: {"dp_weyl_true_nf_and_quotient",Pdp_weyl_true_nf_and_quotient,3},
223: {"dp_weyl_true_nf_and_quotient_mod",Pdp_weyl_true_nf_and_quotient_mod,4},
224: {"dp_weyl_true_nf_and_quotient_marked",Pdp_weyl_true_nf_and_quotient_marked,4},
225: {"dp_weyl_true_nf_and_quotient_marked_mod",Pdp_weyl_true_nf_and_quotient_marked_mod,5},
226:
227:
228: /* Buchberger algorithm */
229: {"dp_weyl_gr_main",Pdp_weyl_gr_main,-5},
230: {"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},
231: {"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4},
232:
233: /* F4 algorithm */
234: {"dp_weyl_f4_main",Pdp_weyl_f4_main,3},
235: {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},
236:
1.3 noro 237: /* Hilbert function */
238: {"dp_monomial_hilbert_poincare",Pdp_monomial_hilbert_poincare,2},
239:
1.1 noro 240: /* misc */
241: {"dp_inv_or_split",Pdp_inv_or_split,3},
242: {"dp_set_weight",Pdp_set_weight,-1},
243: {"dp_set_module_weight",Pdp_set_module_weight,-1},
244: {"dp_set_top_weight",Pdp_set_top_weight,-1},
245: {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1},
246:
247: {"dp_get_denomlist",Pdp_get_denomlist,0},
248: {0,0,0},
249: };
250:
251: struct ftab dp_supp_tab[] = {
252: /* setting flags */
253: {"dp_sort",Pdp_sort,1},
254: {"dp_ord",Pdp_ord,-1},
255: {"dpm_ord",Pdpm_ord,-1},
256: {"dpv_ord",Pdpv_ord,-2},
257: {"dp_set_kara",Pdp_set_kara,-1},
258: {"dp_nelim",Pdp_nelim,-1},
259: {"dp_gr_flags",Pdp_gr_flags,-1},
260: {"dp_gr_print",Pdp_gr_print,-1},
261:
262: /* converters */
263: {"homogenize",Phomogenize,3},
264: {"dp_ptod",Pdp_ptod,-2},
265: {"dp_dtop",Pdp_dtop,2},
266: {"dp_homo",Pdp_homo,1},
267: {"dp_dehomo",Pdp_dehomo,1},
268: {"dp_etov",Pdp_etov,1},
269: {"dp_vtoe",Pdp_vtoe,1},
270: {"dp_dtov",Pdp_dtov,1},
271: {"dp_mdtod",Pdp_mdtod,1},
272: {"dp_mod",Pdp_mod,3},
273: {"dp_rat",Pdp_rat,1},
274: {"dp_ltod",Pdp_ltod,-2},
275:
276: {"dpm_ltod",Pdpm_ltod,2},
277: {"dpm_dtol",Pdpm_dtol,3},
278:
279: /* criteria */
280: {"dp_cri1",Pdp_cri1,2},
281: {"dp_cri2",Pdp_cri2,2},
282: {"dp_criB",Pdp_criB,3},
283:
284: /* simple operation */
285: {"dp_subd",Pdp_subd,2},
286: {"dp_lcm",Pdp_lcm,2},
287: {"dp_hm",Pdp_hm,1},
288: {"dp_ht",Pdp_ht,1},
289: {"dp_hc",Pdp_hc,1},
290: {"dpv_hm",Pdpv_hm,1},
291: {"dpv_ht",Pdpv_ht,1},
292: {"dpv_hc",Pdpv_hc,1},
293: {"dpm_hm",Pdpm_hm,1},
294: {"dpm_ht",Pdpm_ht,1},
295: {"dpm_hc",Pdpm_hc,1},
296: {"dp_rest",Pdp_rest,1},
297: {"dp_initial_term",Pdp_initial_term,1},
298: {"dp_order",Pdp_order,1},
299: {"dp_symb_add",Pdp_symb_add,2},
300:
301: /* degree and size */
302: {"dp_td",Pdp_td,1},
303: {"dp_mag",Pdp_mag,1},
304: {"dp_sugar",Pdp_sugar,1},
305: {"dp_set_sugar",Pdp_set_sugar,2},
306:
307: /* misc */
308: {"dp_mbase",Pdp_mbase,1},
309: {"dp_redble",Pdp_redble,2},
310: {"dp_sep",Pdp_sep,2},
311: {"dp_idiv",Pdp_idiv,2},
312: {"dp_tdiv",Pdp_tdiv,2},
313: {"dp_minp",Pdp_minp,2},
314: {"dp_compute_last_w",Pdp_compute_last_w,5},
315: {"dp_compute_last_t",Pdp_compute_last_t,5},
316: {"dp_compute_essential_df",Pdp_compute_essential_df,2},
317: {"dp_mono_raddec",Pdp_mono_raddec,2},
318: {"dp_mono_reduce",Pdp_mono_reduce,2},
319:
320: {"dp_rref2",Pdp_rref2,2},
321: {"sumi_updatepairs",Psumi_updatepairs,3},
322: {"sumi_symbolic",Psumi_symbolic,5},
323:
324: {0,0,0}
325: };
326:
327: NODE compute_last_w(NODE g,NODE gh,int n,int **v,int row1,int **m1,int row2,int **m2);
328: Q compute_last_t(NODE g,NODE gh,Q t,VECT w1,VECT w2,NODE *homo,VECT *wp);
329:
1.3 noro 330: int comp_by_tdeg(DP *a,DP *b)
331: {
332: int da,db;
333:
334: da = BDY(*a)->dl->td;
335: db = BDY(*b)->dl->td;
336: if ( da>db ) return 1;
337: else if ( da<db ) return -1;
338: else return 0;
339: }
340:
341: #if 0
342: void make_reduced(VECT b)
343: {
344: int n,i,j;
345: DP *p;
346: DP pi;
347:
348: n = b->len;
349: p = (DP *)BDY(b);
350: if ( BDY(p[0])->dl->td == 0 ) {
351: b->len = 1;
352: return;
353: }
354: for ( i = 0; i < n; i++ ) {
355: pi = p[i];
356: if ( !pi ) continue;
357: for ( j = 0; j < n; j++ )
358: if ( i != j && p[j] && dp_redble(p[j],pi) ) p[j] = 0;
359: }
360: for ( i = j = 0; i < n; i++ )
361: if ( p[i] ) p[j++] = p[i];
362: b->len = j;
363: }
364:
365: void make_reduced2(VECT b,int k)
366: {
367: int n,i,j,l;
368: DP *p;
369: DP pi;
370:
371: n = b->len;
372: p = (DP *)BDY(b);
373: for ( i = l = k; i < n; i++ ) {
374: pi = p[i];
375: for ( j = 0; j < k; j++ )
376: if ( dp_redble(pi,p[j]) ) break;
377: if ( j == k )
378: p[l++] = pi;
379: }
380: b->len = l;
381: }
382:
383: struct oEGT eg_comp;
384:
385: void mhp_rec(VECT b,VECT x,P t,P *r)
386: {
387: int n,i,j,k,l,i2,y,len;
388: int *d;
389: Z mone,z;
390: DCP dc,dc1;
391: P s;
392: P *r2;
393: DP *p,*q;
394: DP pi,xj;
395: VECT c;
396: struct oEGT eg0,eg1;
397:
398: n = b->len;
399: y = x->len;
400: p = (DP *)BDY(b);
401: if ( !n ) {
402: r[0] = (P)ONE;
403: return;
404: }
405: if ( n == 1 && BDY(p[0])->dl->td == 0 ) {
406: return;
407: }
408: for ( i = 0; i < n; i++ )
409: if ( BDY(p[i])->dl->td > 1 ) break;
410: if ( i == n ) {
411: r[n] = (P)ONE;
412: return;
413: }
414: get_eg(&eg0);
415: pi = p[i];
416: d = BDY(pi)->dl->d;
417: for ( j = 0; j < y; j++ )
418: if ( d[j] ) break;
419: xj = BDY(x)[j];
420:
421: MKVECT(c,n); q = (DP *)BDY(c);
422: for ( i = k = l = 0; i < n; i++ )
423: if ( BDY(p[i])->dl->d[j] )
424: dp_subd(p[i],xj,&p[k++]);
425: else
426: q[l++] = p[i];
427: for ( i = k, i2 = 0; i2 < l; i++, i2++ )
428: p[i] = q[i2];
429: /* b=(b[0]/xj,...,b[k-1]/xj,b[k],...b[n-1]) where
430: b[0],...,b[k-1] are divisible by k */
431: make_reduced2(b,k);
432: get_eg(&eg1); add_eg(&eg_comp,&eg0,&eg1);
433: mhp_rec(b,x,t,r);
434: /* c = (b[0],...,b[l-1],xj) */
435: q[l] = xj; c->len = l+1;
436: r2 = (P *)CALLOC(y+1,sizeof(P));
437: mhp_rec(c,x,t,r2);
438: get_eg(&eg0);
439: for ( i = 0; i <= y; i++ ) {
440: mulp(CO,r[i],t,&s); addp(CO,s,r2[i],&r[i]);
441: }
442: get_eg(&eg1); add_eg(&eg_comp,&eg0,&eg1);
443: }
444:
445: void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp)
446: {
447: LIST g,v;
448: VL vl;
449: int m,n,i;
450: VECT b,x;
451: NODE t,nd;
452: Z z;
453: P hp,tv,mt,t1,u,w;
454: DP *p;
455: P *plist,*r;
456: struct order_spec *spec;
457: struct oEGT eg0,eg1;
458:
1.4 ! noro 459: if ( get_opt("hf",&val) && val ) hf = 1;
! 460: else hf = 0;
1.3 noro 461: g = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
462: pltovl(v,&vl);
463: m = length(BDY(g)); MKVECT(b,m); p = (DP *)BDY(b);
464: for ( t = BDY(g), i = 0; t; t = NEXT(t), i++ )
465: ptod(CO,vl,(P)BDY(t),&p[i]);
466: n = length(BDY(v)); MKVECT(x,n); p = (DP *)BDY(x);
467: for ( t = BDY(v), i = 0; t; t = NEXT(t), i++ )
468: ptod(CO,vl,(P)BDY(t),&p[i]);
469: create_order_spec(0,0,&spec); initd(spec);
470: /* create (1,1-t,...,(1-t)^n) */
471: plist = (P *)MALLOC((n+1)*sizeof(P));
472: /* t1 = 1-t */
473: makevar("t",&tv); chsgnp(tv,&mt); addp(CO,mt,(P)ONE,&t1);
474: for ( plist[0] = (P)ONE, i = 1; i <= n; i++ )
475: mulp(CO,plist[i-1],t1,&plist[i]);
476: r = (P *)CALLOC(n+1,sizeof(P));
477: make_reduced(b);
478: mhp_rec(b,x,tv,r);
479: for ( hp = 0, i = 0; i <= n; i++ ) {
480: mulp(CO,plist[i],r[i],&u); addp(CO,u,hp,&w); hp = w;
481: }
1.4 ! noro 482: UTOZ(n,z);
! 483: if ( !hf ) {
! 484: nd = mknode(2,hp,z);
! 485: MKLIST(*rp,nd);
! 486: } else {
! 487: P gcd,q;
! 488: int s;
! 489: Z qd;
! 490: ezgcdp(CO,hp,plist[n],&gcd);
! 491: if ( NUM(gcd) ) {
! 492: s = n;
! 493: q = hp;
! 494: } else {
! 495: s = n-ZTOS(DC(gcd));
! 496: sdivp(CO,hp,plist[n-s],&q);
! 497: }
! 498: if ( NUM(q) ) qd = 0;
! 499: else qd = DEG(DC(q));
! 500: nd = mknode(4,hp,z,q,qd);
! 501: MKLIST(*rp,nd);
! 502: }
1.3 noro 503: }
504: #else
505:
506: void dl_print(DL d,int n)
507: {
508: int i;
509:
510: printf("<<");
511: for ( i = 0; i < n; i++ )
512: printf("%d ",d->d[i]);
513: printf(">>\n");
514: }
515:
516: int simple_check(VECT b,int nv)
517: {
518: int n,i,j;
519: DL *p;
520:
521: n = b->len; p = (DL *)b->body;
522: for ( i = 0; i < n; i++ ) {
523: for ( j = 0; j < nv; j++ ) {
524: if ( p[i]->d[j] ) break;
525: }
526: if ( p[i]->d[j] != p[i]->td ) return 0;
527: }
528: return 1;
529: }
530:
531: void make_reduced(VECT b,int nv)
532: {
533: int n,i,j;
534: DL *p;
535: DL pi;
536:
537: n = b->len;
538: p = (DL *)BDY(b);
539: if ( p[0]->td == 0 ) {
540: b->len = 1;
541: return;
542: }
543: for ( i = 0; i < n; i++ ) {
544: pi = p[i];
545: if ( !pi ) continue;
546: for ( j = 0; j < n; j++ )
547: if ( i != j && p[j] && _dl_redble(pi,p[j],nv) ) p[j] = 0;
548: }
549: for ( i = j = 0; i < n; i++ )
550: if ( p[i] ) p[j++] = p[i];
551: b->len = j;
552: }
553:
554: void make_reduced2(VECT b,int k,int nv)
555: {
556: int n,i,j,l;
557: DL *p;
558: DL pi;
559:
560: n = b->len;
561: p = (DL *)BDY(b);
562: for ( i = l = k; i < n; i++ ) {
563: pi = p[i];
564: for ( j = 0; j < k; j++ )
565: if ( _dl_redble(p[j],pi,nv) ) break;
566: if ( j == k )
567: p[l++] = pi;
568: }
569: b->len = l;
570: }
571:
572: int i_all,i_simple;
573:
574: P mhp_simple(VECT b,VECT x,P t)
575: {
576: int n,i,j,nv;
577: DL *p;
578: P hp,mt,s,w;
579: Z z;
580:
581: n = b->len; nv = x->len; p = (DL *)BDY(b);
582: hp = (P)ONE;
583: for ( i = 0; i < n; i++ ) {
584: for ( j = 0; j < nv; j++ )
585: if ( p[i]->d[j] ) break;
586: STOZ(p[i]->d[j],z);
587: chsgnp(t,&mt); mt->dc->d =z;
588: addp(CO,mt,(P)ONE,&s); mulp(CO,hp,s,&w); hp = w;
589: }
590: return hp;
591: }
592:
593: struct oEGT eg_comp;
594:
595: void mhp_rec(VECT b,VECT x,P t,P *r)
596: {
597: int n,i,j,k,l,i2,nv,len;
598: int *d;
599: Z mone,z;
600: DCP dc,dc1;
601: P s;
602: P *r2;
603: DL *p,*q;
604: DL pi,xj,d1;
605: VECT c;
606: struct oEGT eg0,eg1;
607:
608: i_all++;
609: n = b->len; nv = x->len; p = (DL *)BDY(b);
610: if ( !n ) {
611: r[0] = (P)ONE;
612: return;
613: }
614: if ( n == 1 && p[0]->td == 0 )
615: return;
616: for ( i = 0; i < n; i++ )
617: if ( p[i]->td > 1 ) break;
618: if ( i == n ) {
619: r[n] = (P)ONE;
620: return;
621: }
622: #if 0
623: if ( simple_check(b,nv) ) {
624: i_simple++;
625: r[0] = mhp_simple(b,x,t);
626: return;
627: }
628: #endif
629: for ( j = 0, d = p[i]->d; j < nv; j++ )
630: if ( d[j] ) break;
631: xj = BDY(x)[j];
632: MKVECT(c,n); q = (DL *)BDY(c);
633: for ( i = k = l = 0; i < n; i++ )
634: if ( p[i]->d[j] ) {
635: pi = p[i];
636: NEWDL(d1,nv); d1->td =pi->td - 1;
637: memcpy(d1->d,pi->d,nv*sizeof(int));
638: d1->d[j]--;
639: p[k++] = d1;
640: } else
641: q[l++] = p[i];
642: for ( i = k, i2 = 0; i2 < l; i++, i2++ )
643: p[i] = q[i2];
644: /* b=(b[0]/xj,...,b[k-1]/xj,b[k],...b[n-1]) where
645: b[0],...,b[k-1] are divisible by k */
646: make_reduced2(b,k,nv);
647: mhp_rec(b,x,t,r);
648: /* c = (b[0],...,b[l-1],xj) */
649: q[l] = xj; c->len = l+1;
650: r2 = (P *)CALLOC(nv+1,sizeof(P));
651: mhp_rec(c,x,t,r2);
652: // get_eg(&eg0);
653: for ( i = 0; i <= nv; i++ ) {
654: mulp(CO,r[i],t,&s); addp(CO,s,r2[i],&r[i]);
655: }
656: // get_eg(&eg1); add_eg(&eg_comp,&eg0,&eg1);
657: }
658:
1.4 ! noro 659: /* (n+a)Cb as a polynomial of n; return (n+a)*...*(n+a-b+1) */
! 660:
! 661: P binpoly(P n,int a,int b)
! 662: {
! 663: Z z;
! 664: P s,r,t;
! 665: int i;
! 666:
! 667: STOZ(a,z); addp(CO,n,(P)z,&s); r = (P)ONE;
! 668: for ( i = 0; i < b; i++ ) {
! 669: mulp(CO,r,s,&t); r = t;
! 670: subp(CO,s,(P)ONE,&t); s = t;
! 671: }
! 672: return r;
! 673: }
! 674:
1.3 noro 675: void Pdp_monomial_hilbert_poincare(NODE arg,LIST *rp)
676: {
677: LIST g,v;
678: VL vl;
1.4 ! noro 679: int m,n,i,hf;
1.3 noro 680: VECT b,x;
681: NODE t,nd;
682: Z z;
683: P hp,tv,mt,t1,u,w;
684: DP a;
685: DL *p;
686: P *plist,*r;
1.4 ! noro 687: Obj val;
1.3 noro 688:
689: // init_eg(&eg_comp);
1.4 ! noro 690: if ( get_opt("hf",&val) && val ) hf = 1;
! 691: else hf = 0;
1.3 noro 692: i_simple = i_all = 0;
693: g = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
694: pltovl(v,&vl);
695: m = length(BDY(g)); MKVECT(b,m); p = (DL *)BDY(b);
696: for ( t = BDY(g), i = 0; t; t = NEXT(t), i++ ) {
697: ptod(CO,vl,(P)BDY(t),&a); p[i] = BDY(a)->dl;
698: }
699: n = length(BDY(v)); MKVECT(x,n); p = (DL *)BDY(x);
700: for ( t = BDY(v), i = 0; t; t = NEXT(t), i++ ) {
701: ptod(CO,vl,(P)BDY(t),&a); p[i] = BDY(a)->dl;
702: }
703: /* create (1,1-t,...,(1-t)^n) */
704: plist = (P *)MALLOC((n+1)*sizeof(P));
705: /* t1 = 1-t */
706: makevar("t",&tv); chsgnp(tv,&mt); addp(CO,mt,(P)ONE,&t1);
707: for ( plist[0] = (P)ONE, i = 1; i <= n; i++ )
708: mulp(CO,plist[i-1],t1,&plist[i]);
709: r = (P *)CALLOC(n+1,sizeof(P));
710: make_reduced(b,n);
711: mhp_rec(b,x,tv,r);
712: for ( hp = 0, i = 0; i <= n; i++ ) {
713: mulp(CO,plist[i],r[i],&u); addp(CO,u,hp,&w); hp = w;
714: }
715: // printf("all=%d,simple=%d,comp=%.3fsec\n",i_all,i_simple,eg_comp.exectime);
1.4 ! noro 716: UTOZ(n,z);
! 717: if ( !hf ) {
! 718: nd = mknode(2,hp,z);
! 719: MKLIST(*rp,nd);
! 720: } else {
! 721: P gcd,q,head,hphead,t,w,ai,hpoly,nv,bp;
! 722: Z den,d;
! 723: DCP dc,topdc;
! 724: VECT hfhead;
! 725: int s,qd,i;
! 726:
! 727: ezgcdp(CO,hp,plist[n],&gcd);
! 728: if ( NUM(gcd) ) {
! 729: s = n;
! 730: q = hp;
! 731: } else {
! 732: s = n-ZTOS(DEG(DC(gcd)));
! 733: divsp(CO,hp,plist[n-s],&q);
! 734: }
! 735: if ( NUM(q) ) qd = 0;
! 736: else qd = ZTOS(DEG(DC(q)));
! 737: topdc = 0;
! 738: for ( i = 0; i < qd; i++ ) {
! 739: NEWDC(dc); NEXT(dc) = topdc;
! 740: ibin(i+s-1,s-1,&COEF(dc));
! 741: STOZ(i,d); DEG(dc) = d;
! 742: topdc = dc;
! 743: }
! 744: MKP(VR(tv),topdc,head);
! 745: mulp(CO,head,q,&hphead);
! 746: MKVECT(hfhead,qd);
! 747: for ( i = 0; i < qd; i++ )
! 748: coefp(hphead,i,(P *)&BDY(hfhead)[i]);
! 749: hpoly = 0;
! 750: makevar("n",&nv);
! 751: for ( i = 0; i <= qd; i++ ) {
! 752: coefp(q,i,&ai);
! 753: bp = binpoly(nv,s-i-1,s-1);
! 754: mulp(CO,ai,bp,&t);
! 755: addp(CO,hpoly,t,&w);
! 756: hpoly = w;
! 757: }
! 758: factorialz(s-1,&den);
! 759: nd = mknode(5,hp,z,hfhead,hpoly,den);
! 760: MKLIST(*rp,nd);
! 761: }
1.3 noro 762: }
763: #endif
764:
1.1 noro 765: void Pdp_compute_last_t(NODE arg,LIST *rp)
766: {
767: NODE g,gh,homo,n;
768: LIST hlist;
769: VECT v1,v2,w;
770: Q t;
771:
772: g = (NODE)BDY((LIST)ARG0(arg));
773: gh = (NODE)BDY((LIST)ARG1(arg));
774: t = (Q)ARG2(arg);
775: v1 = (VECT)ARG3(arg);
776: v2 = (VECT)ARG4(arg);
777: t = compute_last_t(g,gh,t,v1,v2,&homo,&w);
778: MKLIST(hlist,homo);
779: n = mknode(3,t,w,hlist);
780: MKLIST(*rp,n);
781: }
782:
783: void Pdp_compute_last_w(NODE arg,LIST *rp)
784: {
785: NODE g,gh,r;
786: VECT w,rv;
787: LIST l;
788: MAT w1,w2;
789: int row1,row2,i,j,n;
790: int *v;
791: int **m1,**m2;
792: Z q;
793:
794: g = (NODE)BDY((LIST)ARG0(arg));
795: gh = (NODE)BDY((LIST)ARG1(arg));
796: w = (VECT)ARG2(arg);
797: w1 = (MAT)ARG3(arg);
798: w2 = (MAT)ARG4(arg);
799: n = w1->col;
800: row1 = w1->row;
801: row2 = w2->row;
802: if ( w ) {
803: v = W_ALLOC(n);
1.2 noro 804: for ( i = 0; i < n; i++ ) v[i] = ZTOS((Q)w->body[i]);
1.1 noro 805: } else v = 0;
806: m1 = almat(row1,n);
807: for ( i = 0; i < row1; i++ )
1.2 noro 808: for ( j = 0; j < n; j++ ) m1[i][j] = ZTOS((Q)w1->body[i][j]);
1.1 noro 809: m2 = almat(row2,n);
810: for ( i = 0; i < row2; i++ )
1.2 noro 811: for ( j = 0; j < n; j++ ) m2[i][j] = ZTOS((Q)w2->body[i][j]);
1.1 noro 812: r = compute_last_w(g,gh,n,&v,row1,m1,row2,m2);
813: if ( !r ) *rp = 0;
814: else {
815: MKVECT(rv,n);
816: for ( i = 0; i < n; i++ ) {
1.2 noro 817: STOZ(v[i],q); rv->body[i] = (pointer)q;
1.1 noro 818: }
819: MKLIST(l,r);
820: r = mknode(2,rv,l);
821: MKLIST(*rp,r);
822: }
823: }
824:
825: NODE compute_essential_df(DP *g,DP *gh,int n);
826:
827: void Pdp_compute_essential_df(NODE arg,LIST *rp)
828: {
829: VECT g,gh;
830: NODE r;
831:
832: g = (VECT)ARG0(arg);
833: gh = (VECT)ARG1(arg);
834: r = (NODE)compute_essential_df((DP *)BDY(g),(DP *)BDY(gh),g->len);
835: MKLIST(*rp,r);
836: }
837:
838: void Pdp_inv_or_split(NODE arg,Obj *rp)
839: {
840: NODE gb,newgb;
841: DP f,inv;
842: struct order_spec *spec;
843: LIST list;
844:
845: do_weyl = 0; dp_fcoeffs = 0;
846: asir_assert(ARG0(arg),O_LIST,"dp_inv_or_split");
847: asir_assert(ARG1(arg),O_DP,"dp_inv_or_split");
848: if ( !create_order_spec(0,(Obj)ARG2(arg),&spec) )
849: error("dp_inv_or_split : invalid order specification");
850: gb = BDY((LIST)ARG0(arg));
851: f = (DP)ARG1(arg);
852: newgb = (NODE)dp_inv_or_split(gb,f,spec,&inv);
853: if ( !newgb ) {
854: /* invertible */
855: *rp = (Obj)inv;
856: } else {
857: MKLIST(list,newgb);
858: *rp = (Obj)list;
859: }
860: }
861:
862: void Pdp_sort(NODE arg,DP *rp)
863: {
864: dp_sort((DP)ARG0(arg),rp);
865: }
866:
867: void Pdp_mdtod(NODE arg,DP *rp)
868: {
869: MP m,mr,mr0;
870: DP p;
871: P t;
872:
873: p = (DP)ARG0(arg);
874: if ( !p )
875: *rp = 0;
876: else {
877: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
878: mptop((P)m->c,&t); NEXTMP(mr0,mr); mr->c = (Obj)t; mr->dl = m->dl;
879: }
880: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
881: }
882: }
883:
884: void Pdp_sep(NODE arg,VECT *rp)
885: {
886: DP p,r;
887: MP m,t;
888: MP *w0,*w;
889: int i,n,d,nv,sugar;
890: VECT v;
891: pointer *pv;
892:
893: p = (DP)ARG0(arg); m = BDY(p);
1.2 noro 894: d = ZTOS((Q)ARG1(arg));
1.1 noro 895: for ( t = m, n = 0; t; t = NEXT(t), n++ );
896: if ( d > n )
897: d = n;
898: MKVECT(v,d); *rp = v;
899: pv = BDY(v); nv = p->nv; sugar = p->sugar;
900: w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
901: w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
902: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) {
903: NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
904: }
905: for ( i = 0; i < d; i++ ) {
906: NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
907: pv[i] = (pointer)r;
908: }
909: }
910:
911: void Pdp_idiv(NODE arg,DP *rp)
912: {
913: dp_idiv((DP)ARG0(arg),(Z)ARG1(arg),rp);
914: }
915:
916: void Pdp_cont(NODE arg,Z *rp)
917: {
918: dp_cont((DP)ARG0(arg),rp);
919: }
920:
921: void Pdp_dtov(NODE arg,VECT *rp)
922: {
923: dp_dtov((DP)ARG0(arg),rp);
924: }
925:
926: void Pdp_mbase(NODE arg,LIST *rp)
927: {
928: NODE mb;
929:
930: asir_assert(ARG0(arg),O_LIST,"dp_mbase");
931: dp_mbase(BDY((LIST)ARG0(arg)),&mb);
932: MKLIST(*rp,mb);
933: }
934:
935: void Pdp_etov(NODE arg,VECT *rp)
936: {
937: DP dp;
938: int n,i;
939: int *d;
940: VECT v;
941: Z t;
942:
943: dp = (DP)ARG0(arg);
944: asir_assert(dp,O_DP,"dp_etov");
945: n = dp->nv; d = BDY(dp)->dl->d;
946: MKVECT(v,n);
947: for ( i = 0; i < n; i++ ) {
1.2 noro 948: STOZ(d[i],t); v->body[i] = (pointer)t;
1.1 noro 949: }
950: *rp = v;
951: }
952:
953: void Pdp_vtoe(NODE arg,DP *rp)
954: {
955: DP dp;
956: DL dl;
957: MP m;
958: int n,i,td;
959: int *d;
960: VECT v;
961:
962: v = (VECT)ARG0(arg);
963: asir_assert(v,O_VECT,"dp_vtoe");
964: n = v->len;
965: NEWDL(dl,n); d = dl->d;
966: for ( i = 0, td = 0; i < n; i++ ) {
1.2 noro 967: d[i] = ZTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i);
1.1 noro 968: }
969: dl->td = td;
970: NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0;
971: MKDP(n,m,dp); dp->sugar = td;
972: *rp = dp;
973: }
974:
975: void Pdp_lnf_mod(NODE arg,LIST *rp)
976: {
977: DP r1,r2;
978: NODE b,g,n;
979: int mod;
980:
981: asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
982: asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
983: asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
984: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
1.2 noro 985: mod = ZTOS((Q)ARG2(arg));
1.1 noro 986: dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
987: NEWNODE(n); BDY(n) = (pointer)r1;
988: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
989: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
990: }
991:
992: void Pdp_lnf_f(NODE arg,LIST *rp)
993: {
994: DP r1,r2;
995: NODE b,g,n;
996:
997: asir_assert(ARG0(arg),O_LIST,"dp_lnf_f");
998: asir_assert(ARG1(arg),O_LIST,"dp_lnf_f");
999: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
1000: dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2);
1001: NEWNODE(n); BDY(n) = (pointer)r1;
1002: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
1003: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1004: }
1005:
1006: void Pdp_nf_tab_mod(NODE arg,DP *rp)
1007: {
1008: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
1009: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
1010: asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
1011: dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
1.2 noro 1012: ZTOS((Q)ARG2(arg)),rp);
1.1 noro 1013: }
1014:
1015: void Pdp_nf_tab_f(NODE arg,DP *rp)
1016: {
1017: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f");
1018: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f");
1019: dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp);
1020: }
1021:
1022: void Pdp_ord(NODE arg,Obj *rp)
1023: {
1024: struct order_spec *spec;
1025: LIST v;
1026: struct oLIST f;
1027: Num homo;
1028: int modular;
1029:
1030: f.id = O_LIST; f.body = 0;
1031: if ( !arg && !current_option )
1032: *rp = dp_current_spec->obj;
1033: else {
1034: if ( current_option )
1035: parse_gr_option(&f,current_option,&v,&homo,&modular,&spec);
1036: else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) )
1037: error("dp_ord : invalid order specification");
1038: initd(spec); *rp = spec->obj;
1039: }
1040: }
1041:
1042: void Pdp_ptod(NODE arg,DP *rp)
1043: {
1044: P p;
1045: NODE n;
1046: VL vl,tvl;
1047: struct oLIST f;
1048: int ac;
1049: LIST v;
1050: Num homo;
1051: int modular;
1052: struct order_spec *ord;
1053:
1054: asir_assert(ARG0(arg),O_P,"dp_ptod");
1055: p = (P)ARG0(arg);
1056: ac = argc(arg);
1057: if ( ac == 1 ) {
1058: if ( current_option ) {
1059: f.id = O_LIST; f.body = mknode(1,p);
1060: parse_gr_option(&f,current_option,&v,&homo,&modular,&ord);
1061: initd(ord);
1062: } else
1063: error("dp_ptod : invalid argument");
1064: } else {
1065: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
1066: v = (LIST)ARG1(arg);
1067: }
1068: for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1069: if ( !vl ) {
1070: NEWVL(vl); tvl = vl;
1071: } else {
1072: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
1073: }
1074: VR(tvl) = VR((P)BDY(n));
1075: }
1076: if ( vl )
1077: NEXT(tvl) = 0;
1078: ptod(CO,vl,p,rp);
1079: }
1080:
1081: void Phomogenize(NODE arg,Obj *rp)
1082: {
1083: P p;
1084: DP d,h;
1085: NODE n;
1086: V hv;
1087: VL vl,tvl,last;
1088: struct oLIST f;
1089: LIST v;
1090:
1091: asir_assert(ARG0(arg),O_P,"homogenize");
1092: p = (P)ARG0(arg);
1093: asir_assert(ARG1(arg),O_LIST,"homogenize");
1094: v = (LIST)ARG1(arg);
1095: asir_assert(ARG2(arg),O_P,"homogenize");
1096: hv = VR((P)ARG2(arg));
1097: for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1098: if ( !vl ) {
1099: NEWVL(vl); tvl = vl;
1100: } else {
1101: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
1102: }
1103: VR(tvl) = VR((P)BDY(n));
1104: }
1105: if ( vl ) {
1106: last = tvl;
1107: NEXT(tvl) = 0;
1108: }
1109: ptod(CO,vl,p,&d);
1110: dp_homo(d,&h);
1111: NEWVL(NEXT(last)); last = NEXT(last);
1112: VR(last) = hv; NEXT(last) = 0;
1113: dtop(CO,vl,h,rp);
1114: }
1115:
1116: void Pdp_ltod(NODE arg,DPV *rp)
1117: {
1118: NODE n;
1119: VL vl,tvl;
1120: LIST f,v;
1121: int sugar,i,len,ac,modular;
1122: Num homo;
1123: struct order_spec *ord;
1124: DP *e;
1125: NODE nd,t;
1126:
1127: ac = argc(arg);
1128: asir_assert(ARG0(arg),O_LIST,"dp_ptod");
1129: f = (LIST)ARG0(arg);
1130: if ( ac == 1 ) {
1131: if ( current_option ) {
1132: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1133: initd(ord);
1134: } else
1135: error("dp_ltod : invalid argument");
1136: } else {
1137: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
1138: v = (LIST)ARG1(arg);
1139: }
1140: for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1141: if ( !vl ) {
1142: NEWVL(vl); tvl = vl;
1143: } else {
1144: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
1145: }
1146: VR(tvl) = VR((P)BDY(n));
1147: }
1148: if ( vl )
1149: NEXT(tvl) = 0;
1150:
1151: nd = BDY(f);
1152: len = length(nd);
1153: e = (DP *)MALLOC(len*sizeof(DP));
1154: sugar = 0;
1155: for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) {
1156: ptod(CO,vl,(P)BDY(t),&e[i]);
1157: if ( e[i] )
1158: sugar = MAX(sugar,e[i]->sugar);
1159: }
1160: MKDPV(len,e,*rp);
1161: }
1162:
1163: void Pdpm_ltod(NODE arg,DPM *rp)
1164: {
1165: NODE n;
1166: VL vl,tvl;
1167: LIST f,v;
1168: int i,len;
1169: NODE nd;
1170: NODE t;
1171: DP d;
1172: DPM s,u,w;
1173:
1174: f = (LIST)ARG0(arg);
1175: v = (LIST)ARG1(arg);
1176: for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1177: if ( !vl ) {
1178: NEWVL(vl); tvl = vl;
1179: } else {
1180: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
1181: }
1182: VR(tvl) = VR((P)BDY(n));
1183: }
1184: if ( vl )
1185: NEXT(tvl) = 0;
1186:
1187: nd = BDY(f);
1188: len = length(nd);
1189: for ( i = 0, t = nd, s = 0; i < len; i++, t = NEXT(t) ) {
1190: ptod(CO,vl,(P)BDY(t),&d);
1191: dtodpm(d,i,&u);
1192: adddpm(CO,s,u,&w); s = w;
1193: }
1194: *rp = s;
1195: }
1196:
1197: void Pdpm_dtol(NODE arg,LIST *rp)
1198: {
1199: DPM a;
1200: NODE nd,nd1;
1201: VL vl,tvl;
1202: int n,len,i,pos,nv;
1203: MP *w;
1204: DMM t;
1205: DMM *wa;
1206: MP m;
1207: DP u;
1208: Obj s;
1209:
1210: a = (DPM)ARG0(arg);
1211: for ( vl = 0, nd = BDY((LIST)ARG1(arg)), nv = 0; nd; nd = NEXT(nd), nv++ ) {
1212: if ( !vl ) {
1213: NEWVL(vl); tvl = vl;
1214: } else {
1215: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
1216: }
1217: VR(tvl) = VR((P)BDY(nd));
1218: }
1219: if ( vl )
1220: NEXT(tvl) = 0;
1.2 noro 1221: n = ZTOS((Q)ARG2(arg));
1.1 noro 1222: w = (MP *)CALLOC(n,sizeof(MP));
1223: for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++;
1224: wa = (DMM *)MALLOC(len*sizeof(DMM));
1225: for ( t = BDY(a), i = 0; t; t = NEXT(t), i++ ) wa[i] = t;
1226: for ( i = len-1; i >= 0; i-- ) {
1227: NEWMP(m); m->dl = wa[i]->dl; C(m) = C(wa[i]);
1228: pos = wa[i]->pos;
1229: NEXT(m) = w[pos];
1230: w[pos] = m;
1231: }
1232: nd = 0;
1233: for ( i = n-1; i >= 0; i-- ) {
1234: MKDP(nv,w[i],u); u->sugar = a->sugar; /* XXX */
1235: dtop(CO,vl,u,&s);
1236: MKNODE(nd1,s,nd); nd = nd1;
1237: }
1238: MKLIST(*rp,nd);
1239: }
1240:
1241: void Pdp_dtop(NODE arg,Obj *rp)
1242: {
1243: NODE n;
1244: VL vl,tvl;
1245:
1246: asir_assert(ARG0(arg),O_DP,"dp_dtop");
1247: asir_assert(ARG1(arg),O_LIST,"dp_dtop");
1248: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
1249: if ( !vl ) {
1250: NEWVL(vl); tvl = vl;
1251: } else {
1252: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
1253: }
1254: VR(tvl) = VR((P)BDY(n));
1255: }
1256: if ( vl )
1257: NEXT(tvl) = 0;
1258: dtop(CO,vl,(DP)ARG0(arg),rp);
1259: }
1260:
1261: extern LIST Dist;
1262:
1263: void Pdp_ptozp(NODE arg,Obj *rp)
1264: {
1265: Z t;
1266: NODE tt,p;
1267: NODE n,n0;
1268: char *key;
1269: DP pp;
1270: LIST list;
1271: int get_factor=0;
1272:
1273: asir_assert(ARG0(arg),O_DP,"dp_ptozp");
1274:
1275: /* analyze the option */
1276: if ( current_option ) {
1277: for ( tt = current_option; tt; tt = NEXT(tt) ) {
1278: p = BDY((LIST)BDY(tt));
1279: key = BDY((STRING)BDY(p));
1280: /* value = (Obj)BDY(NEXT(p)); */
1281: if ( !strcmp(key,"factor") ) get_factor=1;
1282: else {
1283: error("ptozp: unknown option.");
1284: }
1285: }
1286: }
1287:
1288: dp_ptozp3((DP)ARG0(arg),&t,&pp);
1289:
1290: /* printexpr(NULL,t); */
1291: /* if the option factor is given, then it returns the answer
1292: in the format [zpoly, num] where num*zpoly is equal to the argument.*/
1293: if (get_factor) {
1294: n0 = mknode(2,pp,t);
1295: MKLIST(list,n0);
1296: *rp = (Obj)list;
1297: } else
1298: *rp = (Obj)pp;
1299: }
1300:
1301: void Pdp_ptozp2(NODE arg,LIST *rp)
1302: {
1303: DP p0,p1,h,r;
1304: NODE n0;
1305:
1306: p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
1307: asir_assert(p0,O_DP,"dp_ptozp2");
1308: asir_assert(p1,O_DP,"dp_ptozp2");
1309: dp_ptozp2(p0,p1,&h,&r);
1310: NEWNODE(n0); BDY(n0) = (pointer)h;
1311: NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
1312: NEXT(NEXT(n0)) = 0;
1313: MKLIST(*rp,n0);
1314: }
1315:
1316: void Pdp_prim(NODE arg,DP *rp)
1317: {
1318: DP t;
1319:
1320: asir_assert(ARG0(arg),O_DP,"dp_prim");
1321: dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
1322: }
1323:
1324: void Pdp_mod(NODE arg,DP *rp)
1325: {
1326: DP p;
1327: int mod;
1328: NODE subst;
1329:
1330: asir_assert(ARG0(arg),O_DP,"dp_mod");
1331: asir_assert(ARG1(arg),O_N,"dp_mod");
1332: asir_assert(ARG2(arg),O_LIST,"dp_mod");
1.2 noro 1333: p = (DP)ARG0(arg); mod = ZTOS((Q)ARG1(arg));
1.1 noro 1334: subst = BDY((LIST)ARG2(arg));
1335: dp_mod(p,mod,subst,rp);
1336: }
1337:
1338: void Pdp_rat(NODE arg,DP *rp)
1339: {
1340: asir_assert(ARG0(arg),O_DP,"dp_rat");
1341: dp_rat((DP)ARG0(arg),rp);
1342: }
1343:
1344: extern int DP_Multiple;
1345:
1346: void Pdp_nf(NODE arg,DP *rp)
1347: {
1348: NODE b;
1349: DP *ps;
1350: DP g;
1351: int full;
1352:
1353: do_weyl = 0; dp_fcoeffs = 0;
1354: asir_assert(ARG0(arg),O_LIST,"dp_nf");
1355: asir_assert(ARG1(arg),O_DP,"dp_nf");
1356: asir_assert(ARG2(arg),O_VECT,"dp_nf");
1357: asir_assert(ARG3(arg),O_N,"dp_nf");
1358: if ( !(g = (DP)ARG1(arg)) ) {
1359: *rp = 0; return;
1360: }
1361: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1362: full = (Q)ARG3(arg) ? 1 : 0;
1363: dp_nf_z(b,g,ps,full,DP_Multiple,rp);
1364: }
1365:
1366: void Pdp_weyl_nf(NODE arg,DP *rp)
1367: {
1368: NODE b;
1369: DP *ps;
1370: DP g;
1371: int full;
1372:
1373: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");
1374: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");
1375: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");
1376: asir_assert(ARG3(arg),O_N,"dp_weyl_nf");
1377: if ( !(g = (DP)ARG1(arg)) ) {
1378: *rp = 0; return;
1379: }
1380: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1381: full = (Q)ARG3(arg) ? 1 : 0;
1382: do_weyl = 1;
1383: dp_nf_z(b,g,ps,full,DP_Multiple,rp);
1384: do_weyl = 0;
1385: }
1386:
1387: void Pdpm_nf(NODE arg,DPM *rp)
1388: {
1389: NODE b;
1390: DPM *ps;
1391: DPM g;
1392: int full;
1393:
1394: if ( !(g = (DPM)ARG1(arg)) ) {
1395: *rp = 0; return;
1396: }
1397: do_weyl = 0; dp_fcoeffs = 0;
1398: asir_assert(ARG0(arg),O_LIST,"dpm_nf");
1399: asir_assert(ARG1(arg),O_DPM,"dpm_nf");
1400: asir_assert(ARG2(arg),O_VECT,"dpm_nf");
1401: asir_assert(ARG3(arg),O_N,"dpm_nf");
1402: b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
1403: full = (Q)ARG3(arg) ? 1 : 0;
1404: dpm_nf_z(b,g,ps,full,DP_Multiple,rp);
1405: }
1406:
1407: void Pdpm_weyl_nf(NODE arg,DPM *rp)
1408: {
1409: NODE b;
1410: DPM *ps;
1411: DPM g;
1412: int full;
1413:
1414: if ( !(g = (DPM)ARG1(arg)) ) {
1415: *rp = 0; return;
1416: }
1417: asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf");
1418: asir_assert(ARG1(arg),O_DPM,"dpm_weyl_nf");
1419: asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf");
1420: asir_assert(ARG3(arg),O_N,"dpm_weyl_nf");
1421: b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
1422: full = (Q)ARG3(arg) ? 1 : 0;
1423: do_weyl = 1;
1424: dpm_nf_z(b,g,ps,full,DP_Multiple,rp);
1425: do_weyl = 0;
1426: }
1427:
1428: /* nf computation using field operations */
1429:
1430: void Pdp_nf_f(NODE arg,DP *rp)
1431: {
1432: NODE b;
1433: DP *ps;
1434: DP g;
1435: int full;
1436:
1437: do_weyl = 0;
1438: asir_assert(ARG0(arg),O_LIST,"dp_nf_f");
1439: asir_assert(ARG1(arg),O_DP,"dp_nf_f");
1440: asir_assert(ARG2(arg),O_VECT,"dp_nf_f");
1441: asir_assert(ARG3(arg),O_N,"dp_nf_f");
1442: if ( !(g = (DP)ARG1(arg)) ) {
1443: *rp = 0; return;
1444: }
1445: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1446: full = (Q)ARG3(arg) ? 1 : 0;
1447: dp_nf_f(b,g,ps,full,rp);
1448: }
1449:
1450: void Pdp_weyl_nf_f(NODE arg,DP *rp)
1451: {
1452: NODE b;
1453: DP *ps;
1454: DP g;
1455: int full;
1456:
1457: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f");
1458: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f");
1459: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f");
1460: asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f");
1461: if ( !(g = (DP)ARG1(arg)) ) {
1462: *rp = 0; return;
1463: }
1464: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1465: full = (Q)ARG3(arg) ? 1 : 0;
1466: do_weyl = 1;
1467: dp_nf_f(b,g,ps,full,rp);
1468: do_weyl = 0;
1469: }
1470:
1471: void Pdpm_nf_f(NODE arg,DPM *rp)
1472: {
1473: NODE b;
1474: DPM *ps;
1475: DPM g;
1476: int full;
1477:
1478: if ( !(g = (DPM)ARG1(arg)) ) {
1479: *rp = 0; return;
1480: }
1481: asir_assert(ARG0(arg),O_LIST,"dpm_nf_f");
1482: asir_assert(ARG1(arg),O_DPM,"dpm_nf_f");
1483: asir_assert(ARG2(arg),O_VECT,"dpm_nf_f");
1484: asir_assert(ARG3(arg),O_N,"dpm_nf_f");
1485: b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
1486: full = (Q)ARG3(arg) ? 1 : 0;
1487: dpm_nf_f(b,g,ps,full,rp);
1488: }
1489:
1490: void Pdpm_weyl_nf_f(NODE arg,DPM *rp)
1491: {
1492: NODE b;
1493: DPM *ps;
1494: DPM g;
1495: int full;
1496:
1497: if ( !(g = (DPM)ARG1(arg)) ) {
1498: *rp = 0; return;
1499: }
1500: asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf_f");
1501: asir_assert(ARG1(arg),O_DP,"dpm_weyl_nf_f");
1502: asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf_f");
1503: asir_assert(ARG3(arg),O_N,"dpm_weyl_nf_f");
1504: b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
1505: full = (Q)ARG3(arg) ? 1 : 0;
1506: do_weyl = 1;
1507: dpm_nf_f(b,g,ps,full,rp);
1508: do_weyl = 0;
1509: }
1510:
1511:
1512: void Pdp_nf_mod(NODE arg,DP *rp)
1513: {
1514: NODE b;
1515: DP g;
1516: DP *ps;
1517: int mod,full,ac;
1518: NODE n,n0;
1519:
1520: do_weyl = 0;
1521: ac = argc(arg);
1522: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
1523: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
1524: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
1525: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
1526: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
1527: if ( !(g = (DP)ARG1(arg)) ) {
1528: *rp = 0; return;
1529: }
1530: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1.2 noro 1531: full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg));
1.1 noro 1532: for ( n0 = n = 0; b; b = NEXT(b) ) {
1533: NEXTNODE(n0,n);
1.2 noro 1534: BDY(n) = (pointer)ZTOS((Q)BDY(b));
1.1 noro 1535: }
1536: if ( n0 )
1537: NEXT(n) = 0;
1538: dp_nf_mod(n0,g,ps,mod,full,rp);
1539: }
1540:
1541: void Pdp_true_nf(NODE arg,LIST *rp)
1542: {
1543: NODE b,n;
1544: DP *ps;
1545: DP g;
1546: DP nm;
1547: P dn;
1548: int full;
1549:
1550: do_weyl = 0; dp_fcoeffs = 0;
1551: asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
1552: asir_assert(ARG1(arg),O_DP,"dp_true_nf");
1553: asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
1554: asir_assert(ARG3(arg),O_N,"dp_nf");
1555: if ( !(g = (DP)ARG1(arg)) ) {
1556: nm = 0; dn = (P)ONE;
1557: } else {
1558: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1559: full = (Q)ARG3(arg) ? 1 : 0;
1560: dp_true_nf(b,g,ps,full,&nm,&dn);
1561: }
1562: NEWNODE(n); BDY(n) = (pointer)nm;
1563: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
1564: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1565: }
1566:
1567: DP *dp_true_nf_and_quotient_marked(NODE b,DP g,DP *ps,DP *hps,DP *rp,P *dnp);
1568:
1569: void Pdp_true_nf_and_quotient_marked(NODE arg,LIST *rp)
1570: {
1571: NODE b,n;
1572: DP *ps,*hps;
1573: DP g;
1574: DP nm;
1575: VECT quo;
1576: P dn;
1577: int full;
1578:
1579: do_weyl = 0; dp_fcoeffs = 0;
1580: asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked");
1581: asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked");
1582: asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked");
1583: asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked");
1584: if ( !(g = (DP)ARG1(arg)) ) {
1585: nm = 0; dn = (P)ONE;
1586: } else {
1587: b = BDY((LIST)ARG0(arg));
1588: ps = (DP *)BDY((VECT)ARG2(arg));
1589: hps = (DP *)BDY((VECT)ARG3(arg));
1590: NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len;
1591: quo->body = (pointer *)dp_true_nf_and_quotient_marked(b,g,ps,hps,&nm,&dn);
1592: }
1593: n = mknode(3,nm,dn,quo);
1594: MKLIST(*rp,n);
1595: }
1596:
1597: void Pdp_true_nf_and_quotient(NODE arg,LIST *rp)
1598: {
1599: NODE narg = mknode(4,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg));
1600: Pdp_true_nf_and_quotient_marked(narg,rp);
1601: }
1602:
1603:
1604: DP *dp_true_nf_and_quotient_marked_mod (NODE b,DP g,DP *ps,DP *hps,int mod,DP *rp,P *dnp);
1605:
1606: void Pdp_true_nf_and_quotient_marked_mod(NODE arg,LIST *rp)
1607: {
1608: NODE b,n;
1609: DP *ps,*hps;
1610: DP g;
1611: DP nm;
1612: VECT quo;
1613: P dn;
1614: int full,mod;
1615:
1616: do_weyl = 0; dp_fcoeffs = 0;
1617: asir_assert(ARG0(arg),O_LIST,"dp_true_nf_and_quotient_marked_mod");
1618: asir_assert(ARG1(arg),O_DP,"dp_true_nf_and_quotient_marked_mod");
1619: asir_assert(ARG2(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod");
1620: asir_assert(ARG3(arg),O_VECT,"dp_true_nf_and_quotient_marked_mod");
1621: asir_assert(ARG4(arg),O_N,"dp_true_nf_and_quotient_marked_mod");
1622: if ( !(g = (DP)ARG1(arg)) ) {
1623: nm = 0; dn = (P)ONE;
1624: } else {
1625: b = BDY((LIST)ARG0(arg));
1626: ps = (DP *)BDY((VECT)ARG2(arg));
1627: hps = (DP *)BDY((VECT)ARG3(arg));
1.2 noro 1628: mod = ZTOS((Q)ARG4(arg));
1.1 noro 1629: NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len;
1630: quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn);
1631: }
1632: n = mknode(3,nm,dn,quo);
1633: MKLIST(*rp,n);
1634: }
1635:
1636: void Pdp_true_nf_and_quotient_mod(NODE arg,LIST *rp)
1637: {
1638: NODE narg = mknode(5,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg),ARG3(arg));
1639: Pdp_true_nf_and_quotient_marked_mod(narg,rp);
1640: }
1641:
1642: void Pdp_true_nf_marked(NODE arg,LIST *rp)
1643: {
1644: NODE b,n;
1645: DP *ps,*hps;
1646: DP g;
1647: DP nm;
1648: Q cont;
1649: P dn;
1650: int full;
1651:
1652: do_weyl = 0; dp_fcoeffs = 0;
1653: asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked");
1654: asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked");
1655: asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked");
1656: asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked");
1657: if ( !(g = (DP)ARG1(arg)) ) {
1658: nm = 0; dn = (P)ONE;
1659: } else {
1660: b = BDY((LIST)ARG0(arg));
1661: ps = (DP *)BDY((VECT)ARG2(arg));
1662: hps = (DP *)BDY((VECT)ARG3(arg));
1663: dp_true_nf_marked(b,g,ps,hps,&nm,(P *)&cont,(P *)&dn);
1664: }
1665: n = mknode(3,nm,cont,dn);
1666: MKLIST(*rp,n);
1667: }
1668:
1669: void Pdp_true_nf_marked_mod(NODE arg,LIST *rp)
1670: {
1671: NODE b,n;
1672: DP *ps,*hps;
1673: DP g;
1674: DP nm;
1675: P dn;
1676: int mod;
1677:
1678: do_weyl = 0; dp_fcoeffs = 0;
1679: asir_assert(ARG0(arg),O_LIST,"dp_true_nf_marked_mod");
1680: asir_assert(ARG1(arg),O_DP,"dp_true_nf_marked_mod");
1681: asir_assert(ARG2(arg),O_VECT,"dp_true_nf_marked_mod");
1682: asir_assert(ARG3(arg),O_VECT,"dp_true_nf_marked_mod");
1683: asir_assert(ARG4(arg),O_N,"dp_true_nf_marked_mod");
1684: if ( !(g = (DP)ARG1(arg)) ) {
1685: nm = 0; dn = (P)ONE;
1686: } else {
1687: b = BDY((LIST)ARG0(arg));
1688: ps = (DP *)BDY((VECT)ARG2(arg));
1689: hps = (DP *)BDY((VECT)ARG3(arg));
1.2 noro 1690: mod = ZTOS((Q)ARG4(arg));
1.1 noro 1691: dp_true_nf_marked_mod(b,g,ps,hps,mod,&nm,&dn);
1692: }
1693: n = mknode(2,nm,dn);
1694: MKLIST(*rp,n);
1695: }
1696:
1697: void Pdp_weyl_nf_mod(NODE arg,DP *rp)
1698: {
1699: NODE b;
1700: DP g;
1701: DP *ps;
1702: int mod,full,ac;
1703: NODE n,n0;
1704:
1705: ac = argc(arg);
1706: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod");
1707: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod");
1708: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod");
1709: asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod");
1710: asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod");
1711: if ( !(g = (DP)ARG1(arg)) ) {
1712: *rp = 0; return;
1713: }
1714: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1.2 noro 1715: full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg));
1.1 noro 1716: for ( n0 = n = 0; b; b = NEXT(b) ) {
1717: NEXTNODE(n0,n);
1.2 noro 1718: BDY(n) = (pointer)ZTOS((Q)BDY(b));
1.1 noro 1719: }
1720: if ( n0 )
1721: NEXT(n) = 0;
1722: do_weyl = 1;
1723: dp_nf_mod(n0,g,ps,mod,full,rp);
1724: do_weyl = 0;
1725: }
1726:
1727: void Pdp_true_nf_mod(NODE arg,LIST *rp)
1728: {
1729: NODE b;
1730: DP g,nm;
1731: P dn;
1732: DP *ps;
1733: int mod,full;
1734: NODE n;
1735:
1736: do_weyl = 0;
1737: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
1738: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
1739: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
1740: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
1741: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
1742: if ( !(g = (DP)ARG1(arg)) ) {
1743: nm = 0; dn = (P)ONEM;
1744: } else {
1745: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
1.2 noro 1746: full = ZTOS((Q)ARG3(arg)); mod = ZTOS((Q)ARG4(arg));
1.1 noro 1747: dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
1748: }
1749: NEWNODE(n); BDY(n) = (pointer)nm;
1750: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
1751: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1752: }
1753:
1754: void Pdp_weyl_true_nf_and_quotient_marked(NODE arg,LIST *rp)
1755: {
1756: NODE b,n;
1757: DP *ps,*hps;
1758: DP g;
1759: DP nm;
1760: VECT quo;
1761: P dn;
1762: int full;
1763:
1764: do_weyl = 1; dp_fcoeffs = 0;
1765: asir_assert(ARG0(arg),O_LIST,"dp_weyl_true_nf_and_quotient_marked");
1766: asir_assert(ARG1(arg),O_DP,"dp_weyl_true_nf_and_quotient_marked");
1767: asir_assert(ARG2(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked");
1768: asir_assert(ARG3(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked");
1769: if ( !(g = (DP)ARG1(arg)) ) {
1770: nm = 0; dn = (P)ONE;
1771: } else {
1772: b = BDY((LIST)ARG0(arg));
1773: ps = (DP *)BDY((VECT)ARG2(arg));
1774: hps = (DP *)BDY((VECT)ARG3(arg));
1775: NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len;
1776: quo->body = (pointer *)dp_true_nf_and_quotient_marked(b,g,ps,hps,&nm,&dn);
1777: }
1778: n = mknode(3,nm,dn,quo);
1779: MKLIST(*rp,n);
1780: }
1781:
1782: void Pdp_weyl_true_nf_and_quotient(NODE arg,LIST *rp)
1783: {
1784: NODE narg = mknode(4,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg));
1785: Pdp_weyl_true_nf_and_quotient_marked(narg,rp);
1786: }
1787:
1788:
1789: void Pdp_weyl_true_nf_and_quotient_marked_mod(NODE arg,LIST *rp)
1790: {
1791: NODE b,n;
1792: DP *ps,*hps;
1793: DP g;
1794: DP nm;
1795: VECT quo;
1796: P dn;
1797: int full,mod;
1798:
1799: do_weyl = 1; dp_fcoeffs = 0;
1800: asir_assert(ARG0(arg),O_LIST,"dp_weyl_true_nf_and_quotient_marked_mod");
1801: asir_assert(ARG1(arg),O_DP,"dp_weyl_true_nf_and_quotient_marked_mod");
1802: asir_assert(ARG2(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked_mod");
1803: asir_assert(ARG3(arg),O_VECT,"dp_weyl_true_nf_and_quotient_marked_mod");
1804: asir_assert(ARG4(arg),O_N,"dp_weyl_true_nf_and_quotient_marked_mod");
1805: if ( !(g = (DP)ARG1(arg)) ) {
1806: nm = 0; dn = (P)ONE;
1807: } else {
1808: b = BDY((LIST)ARG0(arg));
1809: ps = (DP *)BDY((VECT)ARG2(arg));
1810: hps = (DP *)BDY((VECT)ARG3(arg));
1.2 noro 1811: mod = ZTOS((Q)ARG4(arg));
1.1 noro 1812: NEWVECT(quo); quo->len = ((VECT)ARG2(arg))->len;
1813: quo->body = (pointer *)dp_true_nf_and_quotient_marked_mod(b,g,ps,hps,mod,&nm,&dn);
1814: }
1815: n = mknode(3,nm,dn,quo);
1816: MKLIST(*rp,n);
1817: }
1818:
1819: void Pdp_weyl_true_nf_and_quotient_mod(NODE arg,LIST *rp)
1820: {
1821: NODE narg = mknode(5,ARG0(arg),ARG1(arg),ARG2(arg),ARG2(arg),ARG3(arg));
1822: Pdp_weyl_true_nf_and_quotient_marked_mod(narg,rp);
1823: }
1824:
1825:
1826: void Pdp_tdiv(NODE arg,DP *rp)
1827: {
1828: MP m,mr,mr0;
1829: DP p;
1830: Z d,q,r;
1831: int sgn;
1832:
1833: asir_assert(ARG0(arg),O_DP,"dp_tdiv");
1834: asir_assert(ARG1(arg),O_N,"dp_tdiv");
1835: p = (DP)ARG0(arg); d = (Z)ARG1(arg);
1836: if ( !p )
1837: *rp = 0;
1838: else {
1839: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
1840: divqrz((Z)m->c,d,&q,&r);
1841: if ( r ) {
1842: *rp = 0; return;
1843: } else {
1844: NEXTMP(mr0,mr);
1845: mr->c = (Obj)q; mr->dl = m->dl;
1846: }
1847: }
1848: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
1849: }
1850: }
1851:
1852: void Pdp_red_coef(NODE arg,DP *rp)
1853: {
1854: MP m,mr,mr0;
1855: P q,r;
1856: DP p;
1857: P mod;
1858:
1859: p = (DP)ARG0(arg); mod = (P)ARG1(arg);
1860: asir_assert(p,O_DP,"dp_red_coef");
1861: asir_assert(mod,O_P,"dp_red_coef");
1862: if ( !p )
1863: *rp = 0;
1864: else {
1865: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
1866: divsrp(CO,(P)m->c,mod,&q,&r);
1867: if ( r ) {
1868: NEXTMP(mr0,mr); mr->c = (Obj)r; mr->dl = m->dl;
1869: }
1870: }
1871: if ( mr0 ) {
1872: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
1873: } else
1874: *rp = 0;
1875: }
1876: }
1877:
1878: void Pdp_redble(NODE arg,Z *rp)
1879: {
1880: asir_assert(ARG0(arg),O_DP,"dp_redble");
1881: asir_assert(ARG1(arg),O_DP,"dp_redble");
1882: if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
1883: *rp = ONE;
1884: else
1885: *rp = 0;
1886: }
1887:
1888: void Pdp_red_mod(NODE arg,LIST *rp)
1889: {
1890: DP h,r;
1891: P dmy;
1892: NODE n;
1893:
1894: do_weyl = 0;
1895: asir_assert(ARG0(arg),O_DP,"dp_red_mod");
1896: asir_assert(ARG1(arg),O_DP,"dp_red_mod");
1897: asir_assert(ARG2(arg),O_DP,"dp_red_mod");
1898: asir_assert(ARG3(arg),O_N,"dp_red_mod");
1.2 noro 1899: dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),ZTOS((Q)ARG3(arg)),
1.1 noro 1900: &h,&r,&dmy);
1901: NEWNODE(n); BDY(n) = (pointer)h;
1902: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
1903: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1904: }
1905:
1906: void Pdp_subd(NODE arg,DP *rp)
1907: {
1908: DP p1,p2;
1909:
1910: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1911: asir_assert(p1,O_DP,"dp_subd");
1912: asir_assert(p2,O_DP,"dp_subd");
1913: dp_subd(p1,p2,rp);
1914: }
1915:
1916: void Pdp_symb_add(NODE arg,DP *rp)
1917: {
1918: DP p1,p2,r;
1919: NODE s0;
1920: MP mp0,mp;
1921: int nv;
1922:
1923: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1924: asir_assert(p1,O_DP,"dp_symb_add");
1925: asir_assert(p2,O_DP,"dp_symb_add");
1926: if ( !p1 ) { *rp = p2; return; }
1927: else if ( !p2 ) { *rp = p1; return; }
1928: if ( p1->nv != p2->nv )
1929: error("dp_sumb_add : invalid input");
1930: nv = p1->nv;
1931: s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv);
1932: for ( mp0 = 0; s0; s0 = NEXT(s0) ) {
1933: NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (Obj)ONE;
1934: }
1935: NEXT(mp) = 0;
1936: MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar);
1937: *rp = r;
1938: }
1939:
1940: void Pdp_mul_trunc(NODE arg,DP *rp)
1941: {
1942: DP p1,p2,p;
1943:
1944: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg);
1945: asir_assert(p1,O_DP,"dp_mul_trunc");
1946: asir_assert(p2,O_DP,"dp_mul_trunc");
1947: asir_assert(p,O_DP,"dp_mul_trunc");
1948: comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp);
1949: }
1950:
1951: void Pdp_quo(NODE arg,DP *rp)
1952: {
1953: DP p1,p2;
1954:
1955: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1956: asir_assert(p1,O_DP,"dp_quo");
1957: asir_assert(p2,O_DP,"dp_quo");
1958: comm_quod(CO,p1,p2,rp);
1959: }
1960:
1961: void Pdp_weyl_mul(NODE arg,DP *rp)
1962: {
1963: DP p1,p2;
1964:
1965: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1966: asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul");
1967: do_weyl = 1;
1968: muld(CO,p1,p2,rp);
1969: do_weyl = 0;
1970: }
1971:
1972: void Pdp_weyl_act(NODE arg,DP *rp)
1973: {
1974: DP p1,p2;
1975:
1976: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1977: asir_assert(p1,O_DP,"dp_weyl_act"); asir_assert(p2,O_DP,"dp_weyl_act");
1978: weyl_actd(CO,p1,p2,rp);
1979: }
1980:
1981:
1982: void Pdp_weyl_mul_mod(NODE arg,DP *rp)
1983: {
1984: DP p1,p2;
1985: Q m;
1986:
1987: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg);
1988: asir_assert(p1,O_DP,"dp_weyl_mul_mod");
1989: asir_assert(p2,O_DP,"dp_mul_mod");
1990: asir_assert(m,O_N,"dp_mul_mod");
1991: do_weyl = 1;
1.2 noro 1992: mulmd(CO,ZTOS(m),p1,p2,rp);
1.1 noro 1993: do_weyl = 0;
1994: }
1995:
1996: void Pdp_red(NODE arg,LIST *rp)
1997: {
1998: NODE n;
1999: DP head,rest,dmy1;
2000: P dmy;
2001:
2002: do_weyl = 0;
2003: asir_assert(ARG0(arg),O_DP,"dp_red");
2004: asir_assert(ARG1(arg),O_DP,"dp_red");
2005: asir_assert(ARG2(arg),O_DP,"dp_red");
2006: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
2007: NEWNODE(n); BDY(n) = (pointer)head;
2008: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
2009: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
2010: }
2011:
2012: void Pdp_weyl_red(NODE arg,LIST *rp)
2013: {
2014: NODE n;
2015: DP head,rest,dmy1;
2016: P dmy;
2017:
2018: asir_assert(ARG0(arg),O_DP,"dp_weyl_red");
2019: asir_assert(ARG1(arg),O_DP,"dp_weyl_red");
2020: asir_assert(ARG2(arg),O_DP,"dp_weyl_red");
2021: do_weyl = 1;
2022: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
2023: do_weyl = 0;
2024: NEWNODE(n); BDY(n) = (pointer)head;
2025: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
2026: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
2027: }
2028:
2029: void Pdp_sp(NODE arg,DP *rp)
2030: {
2031: DP p1,p2;
2032:
2033: do_weyl = 0;
2034: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
2035: asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
2036: dp_sp(p1,p2,rp);
2037: }
2038:
2039: void Pdp_weyl_sp(NODE arg,DP *rp)
2040: {
2041: DP p1,p2;
2042:
2043: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
2044: asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_weyl_sp");
2045: do_weyl = 1;
2046: dp_sp(p1,p2,rp);
2047: do_weyl = 0;
2048: }
2049:
2050: void Pdpm_sp(NODE arg,DPM *rp)
2051: {
2052: DPM p1,p2;
2053:
2054: do_weyl = 0;
2055: p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg);
2056: asir_assert(p1,O_DPM,"dpm_sp"); asir_assert(p2,O_DPM,"dpm_sp");
2057: dpm_sp(p1,p2,rp);
2058: }
2059:
2060: void Pdpm_weyl_sp(NODE arg,DPM *rp)
2061: {
2062: DPM p1,p2;
2063:
2064: p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg);
2065: asir_assert(p1,O_DPM,"dpm_weyl_sp"); asir_assert(p2,O_DPM,"dpm_weyl_sp");
2066: do_weyl = 1;
2067: dpm_sp(p1,p2,rp);
2068: do_weyl = 0;
2069: }
2070:
2071: void Pdp_sp_mod(NODE arg,DP *rp)
2072: {
2073: DP p1,p2;
2074: int mod;
2075:
2076: do_weyl = 0;
2077: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
2078: asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
2079: asir_assert(ARG2(arg),O_N,"dp_sp_mod");
1.2 noro 2080: mod = ZTOS((Q)ARG2(arg));
1.1 noro 2081: dp_sp_mod(p1,p2,mod,rp);
2082: }
2083:
2084: void Pdp_lcm(NODE arg,DP *rp)
2085: {
2086: int i,n,td;
2087: DL d1,d2,d;
2088: MP m;
2089: DP p1,p2;
2090:
2091: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
2092: asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
2093: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
2094: NEWDL(d,n);
2095: for ( i = 0, td = 0; i < n; i++ ) {
2096: d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i);
2097: }
2098: d->td = td;
2099: NEWMP(m); m->dl = d; m->c = (Obj)ONE; NEXT(m) = 0;
2100: MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */
2101: }
2102:
2103: void Pdp_hm(NODE arg,DP *rp)
2104: {
2105: DP p;
2106:
2107: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
2108: dp_hm(p,rp);
2109: }
2110:
2111: void Pdp_ht(NODE arg,DP *rp)
2112: {
2113: DP p;
2114: MP m,mr;
2115:
2116: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
2117: dp_ht(p,rp);
2118: }
2119:
2120: void Pdp_hc(NODE arg,Obj *rp)
2121: {
2122: asir_assert(ARG0(arg),O_DP,"dp_hc");
2123: if ( !ARG0(arg) )
2124: *rp = 0;
2125: else
2126: *rp = BDY((DP)ARG0(arg))->c;
2127: }
2128:
2129: void Pdp_rest(NODE arg,DP *rp)
2130: {
2131: asir_assert(ARG0(arg),O_DP,"dp_rest");
2132: if ( !ARG0(arg) )
2133: *rp = 0;
2134: else
2135: dp_rest((DP)ARG0(arg),rp);
2136: }
2137:
2138: void Pdp_td(NODE arg,Z *rp)
2139: {
2140: DP p;
2141:
2142: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
2143: if ( !p )
2144: *rp = 0;
2145: else
1.2 noro 2146: STOZ(BDY(p)->dl->td,*rp);
1.1 noro 2147: }
2148:
2149: void Pdp_sugar(NODE arg,Z *rp)
2150: {
2151: DP p;
2152:
2153: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
2154: if ( !p )
2155: *rp = 0;
2156: else
1.2 noro 2157: STOZ(p->sugar,*rp);
1.1 noro 2158: }
2159:
2160: void Pdp_initial_term(NODE arg,Obj *rp)
2161: {
2162: struct order_spec *ord;
2163: Num homo;
2164: int modular,is_list;
2165: LIST v,f,l,initiallist;
2166: NODE n;
2167:
2168: f = (LIST)ARG0(arg);
2169: if ( f && OID(f) == O_LIST )
2170: is_list = 1;
2171: else {
2172: n = mknode(1,f); MKLIST(l,n); f = l;
2173: is_list = 0;
2174: }
2175: if ( current_option ) {
2176: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
2177: initd(ord);
2178: } else
2179: ord = dp_current_spec;
2180: initiallist = dp_initial_term(f,ord);
2181: if ( !is_list )
2182: *rp = (Obj)BDY(BDY(initiallist));
2183: else
2184: *rp = (Obj)initiallist;
2185: }
2186:
2187: void Pdp_order(NODE arg,Obj *rp)
2188: {
2189: struct order_spec *ord;
2190: Num homo;
2191: int modular,is_list;
2192: LIST v,f,l,ordlist;
2193: NODE n;
2194:
2195: f = (LIST)ARG0(arg);
2196: if ( f && OID(f) == O_LIST )
2197: is_list = 1;
2198: else {
2199: n = mknode(1,f); MKLIST(l,n); f = l;
2200: is_list = 0;
2201: }
2202: if ( current_option ) {
2203: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
2204: initd(ord);
2205: } else
2206: ord = dp_current_spec;
2207: ordlist = dp_order(f,ord);
2208: if ( !is_list )
2209: *rp = (Obj)BDY(BDY(ordlist));
2210: else
2211: *rp = (Obj)ordlist;
2212: }
2213:
2214: void Pdp_set_sugar(NODE arg,Q *rp)
2215: {
2216: DP p;
2217: Q q;
2218: int i;
2219:
2220: p = (DP)ARG0(arg);
2221: q = (Q)ARG1(arg);
2222: if ( p && q) {
2223: asir_assert(p,O_DP,"dp_set_sugar");
2224: asir_assert(q,O_N, "dp_set_sugar");
1.2 noro 2225: i = ZTOS(q);
1.1 noro 2226: if (p->sugar < i) {
2227: p->sugar = i;
2228: }
2229: }
2230: *rp = 0;
2231: }
2232:
2233: void Pdp_cri1(NODE arg,Z *rp)
2234: {
2235: DP p1,p2;
2236: int *d1,*d2;
2237: int i,n;
2238:
2239: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
2240: asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
2241: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
2242: for ( i = 0; i < n; i++ )
2243: if ( d1[i] > d2[i] )
2244: break;
2245: *rp = i == n ? ONE : 0;
2246: }
2247:
2248: void Pdp_cri2(NODE arg,Z *rp)
2249: {
2250: DP p1,p2;
2251: int *d1,*d2;
2252: int i,n;
2253:
2254: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
2255: asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
2256: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
2257: for ( i = 0; i < n; i++ )
2258: if ( MIN(d1[i],d2[i]) >= 1 )
2259: break;
2260: *rp = i == n ? ONE : 0;
2261: }
2262:
2263: void Pdp_minp(NODE arg,LIST *rp)
2264: {
2265: NODE tn,tn1,d,dd,dd0,p,tp;
2266: LIST l,minp;
2267: DP lcm,tlcm;
2268: int s,ts;
2269:
2270: asir_assert(ARG0(arg),O_LIST,"dp_minp");
2271: d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
2272: p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
2273: if ( !ARG1(arg) ) {
1.2 noro 2274: s = ZTOS((Q)BDY(p)); p = NEXT(p);
1.1 noro 2275: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
2276: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
2277: tlcm = (DP)BDY(tp); tp = NEXT(tp);
1.2 noro 2278: ts = ZTOS((Q)BDY(tp)); tp = NEXT(tp);
1.1 noro 2279: NEXTNODE(dd0,dd);
2280: if ( ts < s ) {
2281: BDY(dd) = (pointer)minp;
2282: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
2283: } else if ( ts == s ) {
2284: if ( compd(CO,lcm,tlcm) > 0 ) {
2285: BDY(dd) = (pointer)minp;
2286: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
2287: } else
2288: BDY(dd) = BDY(d);
2289: } else
2290: BDY(dd) = BDY(d);
2291: }
2292: } else {
2293: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
2294: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
2295: tlcm = (DP)BDY(tp);
2296: NEXTNODE(dd0,dd);
2297: if ( compd(CO,lcm,tlcm) > 0 ) {
2298: BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
2299: } else
2300: BDY(dd) = BDY(d);
2301: }
2302: }
2303: if ( dd0 )
2304: NEXT(dd) = 0;
2305: MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
2306: }
2307:
2308: void Pdp_criB(NODE arg,LIST *rp)
2309: {
2310: NODE d,ij,dd,ddd;
2311: int i,j,s,n;
2312: DP *ps;
2313: DL ts,ti,tj,lij,tdl;
2314:
2315: asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
1.2 noro 2316: asir_assert(ARG1(arg),O_N,"dp_criB"); s = ZTOS((Q)ARG1(arg));
1.1 noro 2317: asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
2318: if ( !d )
2319: *rp = (LIST)ARG0(arg);
2320: else {
2321: ts = BDY(ps[s])->dl;
2322: n = ps[s]->nv;
2323: NEWDL(tdl,n);
2324: for ( dd = 0; d; d = NEXT(d) ) {
2325: ij = BDY((LIST)BDY(d));
1.2 noro 2326: i = ZTOS((Q)BDY(ij)); ij = NEXT(ij);
2327: j = ZTOS((Q)BDY(ij)); ij = NEXT(ij);
1.1 noro 2328: lij = BDY((DP)BDY(ij))->dl;
2329: ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
2330: if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
2331: || !dl_equal(n,lij,tdl)
2332: || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
2333: && dl_equal(n,tdl,lij))
2334: || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
2335: && dl_equal(n,tdl,lij)) ) {
2336: MKNODE(ddd,BDY(d),dd);
2337: dd = ddd;
2338: }
2339: }
2340: MKLIST(*rp,dd);
2341: }
2342: }
2343:
2344: void Pdp_nelim(NODE arg,Z *rp)
2345: {
2346: if ( arg ) {
2347: asir_assert(ARG0(arg),O_N,"dp_nelim");
1.2 noro 2348: dp_nelim = ZTOS((Q)ARG0(arg));
1.1 noro 2349: }
1.2 noro 2350: STOZ(dp_nelim,*rp);
1.1 noro 2351: }
2352:
2353: void Pdp_mag(NODE arg,Z *rp)
2354: {
2355: DP p;
2356: int s;
2357: MP m;
2358:
2359: p = (DP)ARG0(arg);
2360: asir_assert(p,O_DP,"dp_mag");
2361: if ( !p )
2362: *rp = 0;
2363: else {
2364: for ( s = 0, m = BDY(p); m; m = NEXT(m) )
2365: s += p_mag((P)m->c);
1.2 noro 2366: STOZ(s,*rp);
1.1 noro 2367: }
2368: }
2369:
2370: /* kara_mag is no longer used. */
2371:
2372: void Pdp_set_kara(NODE arg,Z *rp)
2373: {
2374: *rp = 0;
2375: }
2376:
2377: void Pdp_homo(NODE arg,DP *rp)
2378: {
2379: asir_assert(ARG0(arg),O_DP,"dp_homo");
2380: dp_homo((DP)ARG0(arg),rp);
2381: }
2382:
2383: void Pdp_dehomo(NODE arg,DP *rp)
2384: {
2385: asir_assert(ARG0(arg),O_DP,"dp_dehomo");
2386: dp_dehomo((DP)ARG0(arg),rp);
2387: }
2388:
2389: void Pdp_gr_flags(NODE arg,LIST *rp)
2390: {
2391: Obj name,value;
2392: NODE n;
2393:
2394: if ( arg ) {
2395: asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
2396: n = BDY((LIST)ARG0(arg));
2397: while ( n ) {
2398: name = (Obj)BDY(n); n = NEXT(n);
2399: if ( !n )
2400: break;
2401: else {
2402: value = (Obj)BDY(n); n = NEXT(n);
2403: }
2404: dp_set_flag(name,value);
2405: }
2406: }
2407: dp_make_flaglist(rp);
2408: }
2409:
2410: extern int DP_Print, DP_PrintShort;
2411:
2412: void Pdp_gr_print(NODE arg,Z *rp)
2413: {
2414: Z q;
2415: int s;
2416:
2417: if ( arg ) {
2418: asir_assert(ARG0(arg),O_N,"dp_gr_print");
2419: q = (Z)ARG0(arg);
1.2 noro 2420: s = ZTOS(q);
1.1 noro 2421: switch ( s ) {
2422: case 0:
2423: DP_Print = 0; DP_PrintShort = 0;
2424: break;
2425: case 1:
2426: DP_Print = 1;
2427: break;
2428: case 2:
2429: DP_Print = 0; DP_PrintShort = 1;
2430: break;
2431: default:
2432: DP_Print = s; DP_PrintShort = 0;
2433: break;
2434: }
2435: } else {
2436: if ( DP_Print ) {
1.2 noro 2437: STOZ(1,q);
1.1 noro 2438: } else if ( DP_PrintShort ) {
1.2 noro 2439: STOZ(2,q);
1.1 noro 2440: } else
2441: q = 0;
2442: }
2443: *rp = q;
2444: }
2445:
2446: void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo,
2447: int *modular,struct order_spec **ord)
2448: {
2449: NODE t,p;
2450: Z m,z;
2451: char *key;
2452: Obj value,dmy;
2453: int ord_is_set = 0;
2454: int modular_is_set = 0;
2455: int homo_is_set = 0;
2456: VL vl,vl0;
2457: LIST vars;
2458: char xiname[BUFSIZ];
2459: NODE x0,x;
2460: DP d;
2461: P xi;
2462: int nv,i;
2463:
2464: /* extract vars */
2465: vars = 0;
2466: for ( t = opt; t; t = NEXT(t) ) {
2467: p = BDY((LIST)BDY(t));
2468: key = BDY((STRING)BDY(p));
2469: value = (Obj)BDY(NEXT(p));
2470: if ( !strcmp(key,"v") ) {
2471: /* variable list */
2472: vars = (LIST)value;
2473: break;
2474: }
2475: }
2476: if ( vars ) {
2477: *v = vars; pltovl(vars,&vl);
2478: } else {
2479: for ( t = BDY(f); t; t = NEXT(t) )
2480: if ( BDY(t) && OID((Obj)BDY(t))==O_DP )
2481: break;
2482: if ( t ) {
2483: /* f is DP list */
2484: /* create dummy var list */
2485: d = (DP)BDY(t);
2486: nv = NV(d);
2487: for ( i = 0, vl0 = 0, x0 = 0; i < nv; i++ ) {
2488: NEXTVL(vl0,vl);
2489: NEXTNODE(x0,x);
2490: sprintf(xiname,"x%d",i);
2491: makevar(xiname,&xi);
2492: x->body = (pointer)xi;
2493: vl->v = VR((P)xi);
2494: }
2495: if ( vl0 ) {
2496: NEXT(vl) = 0;
2497: NEXT(x) = 0;
2498: }
2499: MKLIST(vars,x0);
2500: *v = vars;
2501: vl = vl0;
2502: } else {
2503: get_vars((Obj)f,&vl); vltopl(vl,v);
2504: }
2505: }
2506:
2507: for ( t = opt; t; t = NEXT(t) ) {
2508: p = BDY((LIST)BDY(t));
2509: key = BDY((STRING)BDY(p));
2510: value = (Obj)BDY(NEXT(p));
2511: if ( !strcmp(key,"v") ) {
2512: /* variable list; ignore */
2513: } else if ( !strcmp(key,"order") ) {
2514: /* order spec */
2515: if ( !vl )
2516: error("parse_gr_option : variables must be specified");
2517: create_order_spec(vl,value,ord);
2518: ord_is_set = 1;
2519: } else if ( !strcmp(key,"block") ) {
2520: create_order_spec(0,value,ord);
2521: ord_is_set = 1;
2522: } else if ( !strcmp(key,"matrix") ) {
2523: create_order_spec(0,value,ord);
2524: ord_is_set = 1;
2525: } else if ( !strcmp(key,"sugarweight") ) {
2526: /* weight */
2527: Pdp_set_weight(NEXT(p),&dmy);
2528: } else if ( !strcmp(key,"homo") ) {
2529: *homo = (Num)value;
2530: homo_is_set = 1;
2531: } else if ( !strcmp(key,"trace") ) {
2532: m = (Z)value;
1.2 noro 2533: STOZ(0x80000000,z);
1.1 noro 2534: if ( !m )
2535: *modular = 0;
2536: else if ( cmpz(m,z) >= 0 )
2537: error("parse_gr_option : too large modulus");
2538: else
1.2 noro 2539: *modular = ZTOS(m);
1.1 noro 2540: modular_is_set = 1;
2541: } else if ( !strcmp(key,"dp") ) {
2542: /* XXX : ignore */
2543: } else
2544: error("parse_gr_option : not implemented");
2545: }
2546: if ( !ord_is_set ) create_order_spec(0,0,ord);
2547: if ( !modular_is_set ) *modular = 0;
2548: if ( !homo_is_set ) *homo = 0;
2549: }
2550:
2551: void Pdp_gr_main(NODE arg,LIST *rp)
2552: {
2553: LIST f,v;
2554: VL vl;
2555: Num homo;
2556: Z m,z;
2557: int modular,ac;
2558: struct order_spec *ord;
2559:
2560: do_weyl = 0;
2561: asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
2562: f = (LIST)ARG0(arg);
2563: f = remove_zero_from_list(f);
2564: if ( !BDY(f) ) {
2565: *rp = f; return;
2566: }
2567: if ( (ac = argc(arg)) == 5 ) {
2568: asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
2569: asir_assert(ARG2(arg),O_N,"dp_gr_main");
2570: asir_assert(ARG3(arg),O_N,"dp_gr_main");
2571: v = (LIST)ARG1(arg);
2572: homo = (Num)ARG2(arg);
2573: m = (Z)ARG3(arg);
1.2 noro 2574: STOZ(0x80000000,z);
1.1 noro 2575: if ( !m )
2576: modular = 0;
2577: else if ( cmpz(m,z) >= 0 )
2578: error("dp_gr_main : too large modulus");
2579: else
1.2 noro 2580: modular = ZTOS(m);
1.1 noro 2581: create_order_spec(0,ARG4(arg),&ord);
2582: } else if ( current_option )
2583: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
2584: else if ( ac == 1 )
2585: parse_gr_option(f,0,&v,&homo,&modular,&ord);
2586: else
2587: error("dp_gr_main : invalid argument");
2588: dp_gr_main(f,v,homo,modular,0,ord,rp);
2589: }
2590:
2591: void Pdp_interreduce(NODE arg,LIST *rp)
2592: {
2593: LIST f,v;
2594: VL vl;
2595: int ac;
2596: struct order_spec *ord;
2597:
2598: do_weyl = 0;
2599: asir_assert(ARG0(arg),O_LIST,"dp_interreduce");
2600: f = (LIST)ARG0(arg);
2601: f = remove_zero_from_list(f);
2602: if ( !BDY(f) ) {
2603: *rp = f; return;
2604: }
2605: if ( (ac = argc(arg)) == 3 ) {
2606: asir_assert(ARG1(arg),O_LIST,"dp_interreduce");
2607: v = (LIST)ARG1(arg);
2608: create_order_spec(0,ARG2(arg),&ord);
2609: }
2610: dp_interreduce(f,v,0,ord,rp);
2611: }
2612:
2613: void Pdp_gr_f_main(NODE arg,LIST *rp)
2614: {
2615: LIST f,v;
2616: Num homo;
2617: int m,field,t;
2618: struct order_spec *ord;
2619: NODE n;
2620:
2621: do_weyl = 0;
2622: asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main");
2623: asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main");
2624: asir_assert(ARG2(arg),O_N,"dp_gr_f_main");
2625: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2626: f = remove_zero_from_list(f);
2627: if ( !BDY(f) ) {
2628: *rp = f; return;
2629: }
2630: homo = (Num)ARG2(arg);
2631: #if 0
2632: asir_assert(ARG3(arg),O_N,"dp_gr_f_main");
1.2 noro 2633: m = ZTOS((Q)ARG3(arg));
1.1 noro 2634: if ( m )
2635: error("dp_gr_f_main : trace lifting is not implemented yet");
2636: create_order_spec(0,ARG4(arg),&ord);
2637: #else
2638: m = 0;
2639: create_order_spec(0,ARG3(arg),&ord);
2640: #endif
2641: field = 0;
2642: for ( n = BDY(f); n; n = NEXT(n) ) {
2643: t = get_field_type(BDY(n));
2644: if ( !t )
2645: continue;
2646: if ( t < 0 )
2647: error("dp_gr_f_main : incosistent coefficients");
2648: if ( !field )
2649: field = t;
2650: else if ( t != field )
2651: error("dp_gr_f_main : incosistent coefficients");
2652: }
2653: dp_gr_main(f,v,homo,m?1:0,field,ord,rp);
2654: }
2655:
2656: void Pdp_f4_main(NODE arg,LIST *rp)
2657: {
2658: LIST f,v;
2659: struct order_spec *ord;
2660:
2661: do_weyl = 0;
2662: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
2663: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
2664: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2665: f = remove_zero_from_list(f);
2666: if ( !BDY(f) ) {
2667: *rp = f; return;
2668: }
2669: create_order_spec(0,ARG2(arg),&ord);
2670: dp_f4_main(f,v,ord,rp);
2671: }
2672:
2673: /* dp_gr_checklist(list of dp) */
2674:
2675: void Pdp_gr_checklist(NODE arg,LIST *rp)
2676: {
2677: VECT g;
2678: LIST dp;
2679: NODE r;
2680: int n;
2681:
2682: do_weyl = 0;
2683: asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist");
2684: asir_assert(ARG1(arg),O_N,"dp_gr_checklist");
1.2 noro 2685: n = ZTOS((Q)ARG1(arg));
1.1 noro 2686: gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp);
2687: r = mknode(2,g,dp);
2688: MKLIST(*rp,r);
2689: }
2690:
2691: void Pdp_f4_mod_main(NODE arg,LIST *rp)
2692: {
2693: LIST f,v;
2694: int m;
2695: struct order_spec *ord;
2696:
2697: do_weyl = 0;
2698: asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main");
2699: asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main");
2700: asir_assert(ARG2(arg),O_N,"dp_f4_mod_main");
1.2 noro 2701: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = ZTOS((Q)ARG2(arg));
1.1 noro 2702: f = remove_zero_from_list(f);
2703: if ( !BDY(f) ) {
2704: *rp = f; return;
2705: }
2706: if ( !m )
2707: error("dp_f4_mod_main : invalid argument");
2708: create_order_spec(0,ARG3(arg),&ord);
2709: dp_f4_mod_main(f,v,m,ord,rp);
2710: }
2711:
2712: void Pdp_gr_mod_main(NODE arg,LIST *rp)
2713: {
2714: LIST f,v;
2715: Num homo;
2716: int m;
2717: struct order_spec *ord;
2718:
2719: do_weyl = 0;
2720: asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
2721: asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
2722: asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
2723: asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
2724: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2725: f = remove_zero_from_list(f);
2726: if ( !BDY(f) ) {
2727: *rp = f; return;
2728: }
1.2 noro 2729: homo = (Num)ARG2(arg); m = ZTOS((Q)ARG3(arg));
1.1 noro 2730: if ( !m )
2731: error("dp_gr_mod_main : invalid argument");
2732: create_order_spec(0,ARG4(arg),&ord);
2733: dp_gr_mod_main(f,v,homo,m,ord,rp);
2734: }
2735:
2736: void Psetmod_ff(NODE node, Obj *val);
2737:
2738: void Pnd_f4(NODE arg,LIST *rp)
2739: {
2740: LIST f,v;
2741: int m,homo,retdp,ac;
2742: Obj val;
2743: Z mq,z;
2744: Num nhomo;
2745: NODE node;
2746: struct order_spec *ord;
2747:
2748: do_weyl = 0;
2749: nd_rref2 = 0;
2750: retdp = 0;
2751: if ( (ac = argc(arg)) == 4 ) {
2752: asir_assert(ARG0(arg),O_LIST,"nd_f4");
2753: asir_assert(ARG1(arg),O_LIST,"nd_f4");
2754: asir_assert(ARG2(arg),O_N,"nd_f4");
2755: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2756: f = remove_zero_from_list(f);
2757: if ( !BDY(f) ) {
2758: *rp = f; return;
2759: }
2760: mq = (Z)ARG2(arg);
1.2 noro 2761: STOZ((unsigned long)0x40000000,z);
1.1 noro 2762: if ( cmpz(mq,z) >= 0 ) {
2763: node = mknode(1,mq);
2764: Psetmod_ff(node,&val);
2765: m = -2;
2766: } else
1.2 noro 2767: m = ZTOS(mq);
1.1 noro 2768: create_order_spec(0,ARG3(arg),&ord);
2769: homo = 0;
2770: if ( get_opt("homo",&val) && val ) homo = 1;
2771: if ( get_opt("dp",&val) && val ) retdp = 1;
2772: if ( get_opt("rref2",&val) && val ) nd_rref2 = 1;
2773: } else if ( ac == 1 ) {
2774: f = (LIST)ARG0(arg);
2775: parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
1.2 noro 2776: homo = ZTOS((Q)nhomo);
1.1 noro 2777: if ( get_opt("dp",&val) && val ) retdp = 1;
2778: if ( get_opt("rref2",&val) && val ) nd_rref2 = 1;
2779: } else
2780: error("nd_f4 : invalid argument");
2781: nd_gr(f,v,m,homo,retdp,1,ord,rp);
2782: }
2783:
2784: void Pnd_gr(NODE arg,LIST *rp)
2785: {
2786: LIST f,v;
2787: int m,homo,retdp,ac;
2788: Obj val;
2789: Z mq,z;
2790: Num nhomo;
2791: NODE node;
2792: struct order_spec *ord;
2793:
2794: do_weyl = 0;
2795: retdp = 0;
2796: if ( (ac=argc(arg)) == 4 ) {
2797: asir_assert(ARG0(arg),O_LIST,"nd_gr");
2798: asir_assert(ARG1(arg),O_LIST,"nd_gr");
2799: asir_assert(ARG2(arg),O_N,"nd_gr");
2800: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2801: f = remove_zero_from_list(f);
2802: if ( !BDY(f) ) {
2803: *rp = f; return;
2804: }
2805: mq = (Z)ARG2(arg);
1.2 noro 2806: STOZ(0x40000000,z);
1.1 noro 2807: if ( cmpz(mq,z) >= 0 ) {
2808: node = mknode(1,mq);
2809: Psetmod_ff(node,&val);
2810: m = -2;
2811: } else
1.2 noro 2812: m = ZTOS(mq);
1.1 noro 2813: create_order_spec(0,ARG3(arg),&ord);
2814: homo = 0;
2815: if ( get_opt("homo",&val) && val ) homo = 1;
2816: if ( get_opt("dp",&val) && val ) retdp = 1;
2817: } else if ( ac == 1 ) {
2818: f = (LIST)ARG0(arg);
2819: parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
1.2 noro 2820: homo = ZTOS((Q)nhomo);
1.1 noro 2821: if ( get_opt("dp",&val) && val ) retdp = 1;
2822: } else
2823: error("nd_gr : invalid argument");
2824: nd_gr(f,v,m,homo,retdp,0,ord,rp);
2825: }
2826:
2827: void Pnd_gr_postproc(NODE arg,LIST *rp)
2828: {
2829: LIST f,v;
2830: int m,do_check;
2831: Z mq,z;
2832: Obj val;
2833: NODE node;
2834: struct order_spec *ord;
2835:
2836: do_weyl = 0;
2837: asir_assert(ARG0(arg),O_LIST,"nd_gr");
2838: asir_assert(ARG1(arg),O_LIST,"nd_gr");
2839: asir_assert(ARG2(arg),O_N,"nd_gr");
2840: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2841: f = remove_zero_from_list(f);
2842: if ( !BDY(f) ) {
2843: *rp = f; return;
2844: }
2845: mq = (Z)ARG2(arg);
1.2 noro 2846: STOZ(0x40000000,z);
1.1 noro 2847: if ( cmpz(mq,z) >= 0 ) {
2848: node = mknode(1,mq);
2849: Psetmod_ff(node,&val);
2850: m = -2;
2851: } else
1.2 noro 2852: m = ZTOS(mq);
1.1 noro 2853: create_order_spec(0,ARG3(arg),&ord);
2854: do_check = ARG4(arg) ? 1 : 0;
2855: nd_gr_postproc(f,v,m,ord,do_check,rp);
2856: }
2857:
2858: void Pnd_gr_recompute_trace(NODE arg,LIST *rp)
2859: {
2860: LIST f,v,tlist;
2861: int m;
2862: struct order_spec *ord;
2863:
2864: do_weyl = 0;
2865: asir_assert(ARG0(arg),O_LIST,"nd_gr_recompute_trace");
2866: asir_assert(ARG1(arg),O_LIST,"nd_gr_recompute_trace");
2867: asir_assert(ARG2(arg),O_N,"nd_gr_recompute_trace");
2868: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.2 noro 2869: m = ZTOS((Q)ARG2(arg));
1.1 noro 2870: create_order_spec(0,ARG3(arg),&ord);
2871: tlist = (LIST)ARG4(arg);
2872: nd_gr_recompute_trace(f,v,m,ord,tlist,rp);
2873: }
2874:
2875: Obj nd_btog_one(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist,int pos);
2876: Obj nd_btog(LIST f,LIST v,int m,struct order_spec *ord,LIST tlist);
2877:
2878: void Pnd_btog(NODE arg,Obj *rp)
2879: {
2880: LIST f,v,tlist;
2881: Z mq,z;
2882: int m,ac,pos;
2883: struct order_spec *ord;
2884: NODE node;
2885: pointer val;
2886:
2887: do_weyl = 0;
2888: asir_assert(ARG0(arg),O_LIST,"nd_btog");
2889: asir_assert(ARG1(arg),O_LIST,"nd_btog");
2890: asir_assert(ARG2(arg),O_N,"nd_btog");
2891: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2892: mq = (Z)ARG2(arg);
1.2 noro 2893: STOZ(0x40000000,z);
1.1 noro 2894: if ( cmpz(mq,z) >= 0 ) {
2895: node = mknode(1,mq);
2896: Psetmod_ff(node,(Obj *)&val);
2897: m = -2;
2898: } else
1.2 noro 2899: m = ZTOS(mq);
1.1 noro 2900: create_order_spec(0,ARG3(arg),&ord);
2901: tlist = (LIST)ARG4(arg);
2902: if ( (ac = argc(arg)) == 6 ) {
2903: asir_assert(ARG5(arg),O_N,"nd_btog");
1.2 noro 2904: pos = ZTOS((Q)ARG5(arg));
1.1 noro 2905: *rp = nd_btog_one(f,v,m,ord,tlist,pos);
2906: } else if ( ac == 5 )
2907: *rp = nd_btog(f,v,m,ord,tlist);
2908: else
2909: error("nd_btog : argument mismatch");
2910: }
2911:
2912: void Pnd_weyl_gr_postproc(NODE arg,LIST *rp)
2913: {
2914: LIST f,v;
2915: int m,do_check;
2916: struct order_spec *ord;
2917:
2918: do_weyl = 1;
2919: asir_assert(ARG0(arg),O_LIST,"nd_gr");
2920: asir_assert(ARG1(arg),O_LIST,"nd_gr");
2921: asir_assert(ARG2(arg),O_N,"nd_gr");
2922: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2923: f = remove_zero_from_list(f);
2924: if ( !BDY(f) ) {
2925: *rp = f; do_weyl = 0; return;
2926: }
1.2 noro 2927: m = ZTOS((Q)ARG2(arg));
1.1 noro 2928: create_order_spec(0,ARG3(arg),&ord);
2929: do_check = ARG4(arg) ? 1 : 0;
2930: nd_gr_postproc(f,v,m,ord,do_check,rp);
2931: do_weyl = 0;
2932: }
2933:
2934: void Pnd_gr_trace(NODE arg,LIST *rp)
2935: {
2936: LIST f,v;
2937: int m,homo,ac;
2938: Num nhomo;
2939: struct order_spec *ord;
2940:
2941: do_weyl = 0;
2942: if ( (ac = argc(arg)) == 5 ) {
2943: asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");
2944: asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");
2945: asir_assert(ARG2(arg),O_N,"nd_gr_trace");
2946: asir_assert(ARG3(arg),O_N,"nd_gr_trace");
2947: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2948: f = remove_zero_from_list(f);
2949: if ( !BDY(f) ) {
2950: *rp = f; return;
2951: }
1.2 noro 2952: homo = ZTOS((Q)ARG2(arg));
2953: m = ZTOS((Q)ARG3(arg));
1.1 noro 2954: create_order_spec(0,ARG4(arg),&ord);
2955: } else if ( ac == 1 ) {
2956: f = (LIST)ARG0(arg);
2957: parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
1.2 noro 2958: homo = ZTOS((Q)nhomo);
1.1 noro 2959: } else
2960: error("nd_gr_trace : invalid argument");
2961: nd_gr_trace(f,v,m,homo,0,ord,rp);
2962: }
2963:
2964: void Pnd_f4_trace(NODE arg,LIST *rp)
2965: {
2966: LIST f,v;
2967: int m,homo,ac;
2968: Num nhomo;
2969: struct order_spec *ord;
2970:
2971: do_weyl = 0;
2972: if ( (ac = argc(arg))==5 ) {
2973: asir_assert(ARG0(arg),O_LIST,"nd_f4_trace");
2974: asir_assert(ARG1(arg),O_LIST,"nd_f4_trace");
2975: asir_assert(ARG2(arg),O_N,"nd_f4_trace");
2976: asir_assert(ARG3(arg),O_N,"nd_f4_trace");
2977: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
2978: f = remove_zero_from_list(f);
2979: if ( !BDY(f) ) {
2980: *rp = f; return;
2981: }
1.2 noro 2982: homo = ZTOS((Q)ARG2(arg));
2983: m = ZTOS((Q)ARG3(arg));
1.1 noro 2984: create_order_spec(0,ARG4(arg),&ord);
2985: } else if ( ac == 1 ) {
2986: f = (LIST)ARG0(arg);
2987: parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
1.2 noro 2988: homo = ZTOS((Q)nhomo);
1.1 noro 2989: } else
2990: error("nd_gr_trace : invalid argument");
2991: nd_gr_trace(f,v,m,homo,1,ord,rp);
2992: }
2993:
2994: void Pnd_weyl_gr(NODE arg,LIST *rp)
2995: {
2996: LIST f,v;
2997: int m,homo,retdp,ac;
2998: Obj val;
2999: Num nhomo;
3000: struct order_spec *ord;
3001:
3002: do_weyl = 1;
3003: retdp = 0;
3004: if ( (ac = argc(arg)) == 4 ) {
3005: asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr");
3006: asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr");
3007: asir_assert(ARG2(arg),O_N,"nd_weyl_gr");
3008: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
3009: f = remove_zero_from_list(f);
3010: if ( !BDY(f) ) {
3011: *rp = f; do_weyl = 0; return;
3012: }
1.2 noro 3013: m = ZTOS((Q)ARG2(arg));
1.1 noro 3014: create_order_spec(0,ARG3(arg),&ord);
3015: homo = 0;
3016: if ( get_opt("homo",&val) && val ) homo = 1;
3017: if ( get_opt("dp",&val) && val ) retdp = 1;
3018: } else if ( ac == 1 ) {
3019: f = (LIST)ARG0(arg);
3020: parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
1.2 noro 3021: homo = ZTOS((Q)nhomo);
1.1 noro 3022: if ( get_opt("dp",&val) && val ) retdp = 1;
3023: } else
3024: error("nd_weyl_gr : invalid argument");
3025: nd_gr(f,v,m,homo,retdp,0,ord,rp);
3026: do_weyl = 0;
3027: }
3028:
3029: void Pnd_weyl_gr_trace(NODE arg,LIST *rp)
3030: {
3031: LIST f,v;
3032: int m,homo,ac;
3033: Num nhomo;
3034: struct order_spec *ord;
3035:
3036: do_weyl = 1;
3037: if ( (ac = argc(arg)) == 5 ) {
3038: asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace");
3039: asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace");
3040: asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace");
3041: asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace");
3042: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
3043: f = remove_zero_from_list(f);
3044: if ( !BDY(f) ) {
3045: *rp = f; do_weyl = 0; return;
3046: }
1.2 noro 3047: homo = ZTOS((Q)ARG2(arg));
3048: m = ZTOS((Q)ARG3(arg));
1.1 noro 3049: create_order_spec(0,ARG4(arg),&ord);
3050: } else if ( ac == 1 ) {
3051: f = (LIST)ARG0(arg);
3052: parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
1.2 noro 3053: homo = ZTOS((Q)nhomo);
1.1 noro 3054: } else
3055: error("nd_weyl_gr_trace : invalid argument");
3056: nd_gr_trace(f,v,m,homo,0,ord,rp);
3057: do_weyl = 0;
3058: }
3059:
3060: void Pnd_nf(NODE arg,Obj *rp)
3061: {
3062: Obj f;
3063: LIST g,v;
3064: struct order_spec *ord;
3065:
3066: do_weyl = 0;
3067: asir_assert(ARG1(arg),O_LIST,"nd_nf");
3068: asir_assert(ARG2(arg),O_LIST,"nd_nf");
3069: asir_assert(ARG4(arg),O_N,"nd_nf");
3070: f = (Obj)ARG0(arg);
3071: g = (LIST)ARG1(arg); g = remove_zero_from_list(g);
3072: if ( !BDY(g) ) {
3073: *rp = f; return;
3074: }
3075: v = (LIST)ARG2(arg);
3076: create_order_spec(0,ARG3(arg),&ord);
1.2 noro 3077: nd_nf_p(f,g,v,ZTOS((Q)ARG4(arg)),ord,rp);
1.1 noro 3078: }
3079:
3080: void Pnd_weyl_nf(NODE arg,Obj *rp)
3081: {
3082: Obj f;
3083: LIST g,v;
3084: struct order_spec *ord;
3085:
3086: do_weyl = 1;
3087: asir_assert(ARG1(arg),O_LIST,"nd_weyl_nf");
3088: asir_assert(ARG2(arg),O_LIST,"nd_weyl_nf");
3089: asir_assert(ARG4(arg),O_N,"nd_weyl_nf");
3090: f = (Obj)ARG0(arg);
3091: g = (LIST)ARG1(arg); g = remove_zero_from_list(g);
3092: if ( !BDY(g) ) {
3093: *rp = f; return;
3094: }
3095: v = (LIST)ARG2(arg);
3096: create_order_spec(0,ARG3(arg),&ord);
1.2 noro 3097: nd_nf_p(f,g,v,ZTOS((Q)ARG4(arg)),ord,rp);
1.1 noro 3098: }
3099:
3100: /* for Weyl algebra */
3101:
3102: void Pdp_weyl_gr_main(NODE arg,LIST *rp)
3103: {
3104: LIST f,v;
3105: Num homo;
3106: Z m,z;
3107: int modular,ac;
3108: struct order_spec *ord;
3109:
3110:
3111: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
3112: f = (LIST)ARG0(arg);
3113: f = remove_zero_from_list(f);
3114: if ( !BDY(f) ) {
3115: *rp = f; return;
3116: }
3117: if ( (ac = argc(arg)) == 5 ) {
3118: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
3119: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
3120: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
3121: v = (LIST)ARG1(arg);
3122: homo = (Num)ARG2(arg);
3123: m = (Z)ARG3(arg);
1.2 noro 3124: STOZ(0x80000000,z);
1.1 noro 3125: if ( !m )
3126: modular = 0;
3127: else if ( cmpz(m,z) >= 0 )
3128: error("dp_weyl_gr_main : too large modulus");
3129: else
1.2 noro 3130: modular = ZTOS(m);
1.1 noro 3131: create_order_spec(0,ARG4(arg),&ord);
3132: } else if ( current_option )
3133: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
3134: else if ( ac == 1 )
3135: parse_gr_option(f,0,&v,&homo,&modular,&ord);
3136: else
3137: error("dp_weyl_gr_main : invalid argument");
3138: do_weyl = 1;
3139: dp_gr_main(f,v,homo,modular,0,ord,rp);
3140: do_weyl = 0;
3141: }
3142:
3143: void Pdp_weyl_gr_f_main(NODE arg,LIST *rp)
3144: {
3145: LIST f,v;
3146: Num homo;
3147: struct order_spec *ord;
3148:
3149: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
3150: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
3151: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
3152: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
3153: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
3154: f = remove_zero_from_list(f);
3155: if ( !BDY(f) ) {
3156: *rp = f; return;
3157: }
3158: homo = (Num)ARG2(arg);
3159: create_order_spec(0,ARG3(arg),&ord);
3160: do_weyl = 1;
3161: dp_gr_main(f,v,homo,0,1,ord,rp);
3162: do_weyl = 0;
3163: }
3164:
3165: void Pdp_weyl_f4_main(NODE arg,LIST *rp)
3166: {
3167: LIST f,v;
3168: struct order_spec *ord;
3169:
3170: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
3171: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
3172: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
3173: f = remove_zero_from_list(f);
3174: if ( !BDY(f) ) {
3175: *rp = f; return;
3176: }
3177: create_order_spec(0,ARG2(arg),&ord);
3178: do_weyl = 1;
3179: dp_f4_main(f,v,ord,rp);
3180: do_weyl = 0;
3181: }
3182:
3183: void Pdp_weyl_f4_mod_main(NODE arg,LIST *rp)
3184: {
3185: LIST f,v;
3186: int m;
3187: struct order_spec *ord;
3188:
3189: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
3190: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
3191: asir_assert(ARG2(arg),O_N,"dp_f4_main");
1.2 noro 3192: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = ZTOS((Q)ARG2(arg));
1.1 noro 3193: f = remove_zero_from_list(f);
3194: if ( !BDY(f) ) {
3195: *rp = f; return;
3196: }
3197: if ( !m )
3198: error("dp_weyl_f4_mod_main : invalid argument");
3199: create_order_spec(0,ARG3(arg),&ord);
3200: do_weyl = 1;
3201: dp_f4_mod_main(f,v,m,ord,rp);
3202: do_weyl = 0;
3203: }
3204:
3205: void Pdp_weyl_gr_mod_main(NODE arg,LIST *rp)
3206: {
3207: LIST f,v;
3208: Num homo;
3209: int m;
3210: struct order_spec *ord;
3211:
3212: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");
3213: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");
3214: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");
3215: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");
3216: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
3217: f = remove_zero_from_list(f);
3218: if ( !BDY(f) ) {
3219: *rp = f; return;
3220: }
1.2 noro 3221: homo = (Num)ARG2(arg); m = ZTOS((Q)ARG3(arg));
1.1 noro 3222: if ( !m )
3223: error("dp_weyl_gr_mod_main : invalid argument");
3224: create_order_spec(0,ARG4(arg),&ord);
3225: do_weyl = 1;
3226: dp_gr_mod_main(f,v,homo,m,ord,rp);
3227: do_weyl = 0;
3228: }
3229:
3230: VECT current_dl_weight_vector_obj;
3231: int *current_dl_weight_vector;
3232: int dp_negative_weight;
3233:
3234: void Pdp_set_weight(NODE arg,VECT *rp)
3235: {
3236: VECT v;
3237: int i,n;
3238: NODE node;
3239:
3240: if ( !arg )
3241: *rp = current_dl_weight_vector_obj;
3242: else if ( !ARG0(arg) ) {
3243: current_dl_weight_vector_obj = 0;
3244: current_dl_weight_vector = 0;
3245: dp_negative_weight = 0;
3246: *rp = 0;
3247: } else {
3248: if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
3249: error("dp_set_weight : invalid argument");
3250: if ( OID(ARG0(arg)) == O_VECT )
3251: v = (VECT)ARG0(arg);
3252: else {
3253: node = (NODE)BDY((LIST)ARG0(arg));
3254: n = length(node);
3255: MKVECT(v,n);
3256: for ( i = 0; i < n; i++, node = NEXT(node) )
3257: BDY(v)[i] = BDY(node);
3258: }
3259: current_dl_weight_vector_obj = v;
3260: n = v->len;
3261: current_dl_weight_vector = (int *)CALLOC(n,sizeof(int));
3262: for ( i = 0; i < n; i++ )
1.2 noro 3263: current_dl_weight_vector[i] = ZTOS((Q)v->body[i]);
1.1 noro 3264: for ( i = 0; i < n; i++ )
3265: if ( current_dl_weight_vector[i] < 0 ) break;
3266: if ( i < n )
3267: dp_negative_weight = 1;
3268: else
3269: dp_negative_weight = 0;
3270: *rp = v;
3271: }
3272: }
3273:
3274: VECT current_module_weight_vector_obj;
3275: int *current_module_weight_vector;
3276:
3277: void Pdp_set_module_weight(NODE arg,VECT *rp)
3278: {
3279: VECT v;
3280: int i,n;
3281: NODE node;
3282:
3283: if ( !arg )
3284: *rp = current_module_weight_vector_obj;
3285: else if ( !ARG0(arg) ) {
3286: current_module_weight_vector_obj = 0;
3287: current_module_weight_vector = 0;
3288: *rp = 0;
3289: } else {
3290: if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
3291: error("dp_module_set_weight : invalid argument");
3292: if ( OID(ARG0(arg)) == O_VECT )
3293: v = (VECT)ARG0(arg);
3294: else {
3295: node = (NODE)BDY((LIST)ARG0(arg));
3296: n = length(node);
3297: MKVECT(v,n);
3298: for ( i = 0; i < n; i++, node = NEXT(node) )
3299: BDY(v)[i] = BDY(node);
3300: }
3301: current_module_weight_vector_obj = v;
3302: n = v->len;
3303: current_module_weight_vector = (int *)CALLOC(n,sizeof(int));
3304: for ( i = 0; i < n; i++ )
1.2 noro 3305: current_module_weight_vector[i] = ZTOS((Q)v->body[i]);
1.1 noro 3306: *rp = v;
3307: }
3308: }
3309:
3310: extern Obj current_top_weight;
3311: extern Obj nd_top_weight;
3312:
3313: void Pdp_set_top_weight(NODE arg,Obj *rp)
3314: {
3315: VECT v;
3316: MAT m;
3317: Obj obj;
3318: int i,j,n,id,row,col;
3319: Q *mi;
3320: NODE node;
3321:
3322: if ( !arg )
3323: *rp = current_top_weight;
3324: else if ( !ARG0(arg) ) {
3325: reset_top_weight();
3326: *rp = 0;
3327: } else {
3328: id = OID(ARG0(arg));
3329: if ( id != O_VECT && id != O_MAT && id != O_LIST )
3330: error("dp_set_top_weight : invalid argument");
3331: if ( id == O_LIST ) {
3332: node = (NODE)BDY((LIST)ARG0(arg));
3333: n = length(node);
3334: MKVECT(v,n);
3335: for ( i = 0; i < n; i++, node = NEXT(node) )
3336: BDY(v)[i] = BDY(node);
3337: obj = (Obj)v;
3338: } else
3339: obj = ARG0(arg);
3340: if ( OID(obj) == O_VECT ) {
3341: v = (VECT)obj;
3342: for ( i = 0; i < v->len; i++ )
3343: if ( !INT((Q)BDY(v)[i]) || sgnz((Z)BDY(v)[i]) < 0 )
3344: error("dp_set_top_weight : each element must be a non-negative integer");
3345: } else {
3346: m = (MAT)obj; row = m->row; col = m->col;
3347: for ( i = 0; i < row; i++ )
3348: for ( j = 0, mi = (Q *)BDY(m)[i]; j < col; j++ )
3349: if ( !INT((Q)mi[j]) || sgnz((Z)mi[j]) < 0 )
3350: error("dp_set_top_weight : each element must be a non-negative integer");
3351: }
3352: current_top_weight = obj;
3353: nd_top_weight = obj;
3354: *rp = current_top_weight;
3355: }
3356: }
3357:
3358: LIST get_denomlist();
3359:
3360: void Pdp_get_denomlist(LIST *rp)
3361: {
3362: *rp = get_denomlist();
3363: }
3364:
3365: static VECT current_weyl_weight_vector_obj;
3366: int *current_weyl_weight_vector;
3367:
3368: void Pdp_weyl_set_weight(NODE arg,VECT *rp)
3369: {
3370: VECT v;
3371: NODE node;
3372: int i,n;
3373:
3374: if ( !arg )
3375: *rp = current_weyl_weight_vector_obj;
3376: else if ( !ARG0(arg) ) {
3377: current_weyl_weight_vector_obj = 0;
3378: current_weyl_weight_vector = 0;
3379: *rp = 0;
3380: } else {
3381: if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
3382: error("dp_weyl_set_weight : invalid argument");
3383: if ( OID(ARG0(arg)) == O_VECT )
3384: v = (VECT)ARG0(arg);
3385: else {
3386: node = (NODE)BDY((LIST)ARG0(arg));
3387: n = length(node);
3388: MKVECT(v,n);
3389: for ( i = 0; i < n; i++, node = NEXT(node) )
3390: BDY(v)[i] = BDY(node);
3391: }
3392: current_weyl_weight_vector_obj = v;
3393: n = v->len;
3394: current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int));
3395: for ( i = 0; i < n; i++ )
1.2 noro 3396: current_weyl_weight_vector[i] = ZTOS((Q)v->body[i]);
1.1 noro 3397: *rp = v;
3398: }
3399: }
3400:
3401: NODE mono_raddec(NODE ideal);
3402:
3403: void Pdp_mono_raddec(NODE arg,LIST *rp)
3404: {
3405: NODE ideal,rd,t,t1,r,r1,u;
3406: VL vl0,vl;
3407: int nv,i,bpi;
3408: int *s;
3409: DP dp;
3410: P *v;
3411: LIST l;
3412:
3413: ideal = BDY((LIST)ARG0(arg));
3414: if ( !ideal ) *rp = (LIST)ARG0(arg);
3415: else {
3416: t = BDY((LIST)ARG1(arg));
3417: nv = length(t);
3418: v = (P *)MALLOC(nv*sizeof(P));
3419: for ( vl0 = 0, i = 0; t; t = NEXT(t), i++ ) {
3420: NEXTVL(vl0,vl); VR(vl) = VR((P)BDY(t));
3421: MKV(VR(vl),v[i]);
3422: }
3423: if ( vl0 ) NEXT(vl) = 0;
3424: for ( t = 0, r = ideal; r; r = NEXT(r) ) {
3425: ptod(CO,vl0,BDY(r),&dp); MKNODE(t1,dp,t); t = t1;
3426: }
3427: rd = mono_raddec(t);
3428: r = 0;
3429: bpi = (sizeof(int)/sizeof(char))*8;
3430: for ( u = rd; u; u = NEXT(u) ) {
3431: s = (int *)BDY(u);
3432: for ( i = nv-1, t = 0; i >= 0; i-- )
3433: if ( s[i/bpi]&(1<<(i%bpi)) ) {
3434: MKNODE(t1,v[i],t); t = t1;
3435: }
3436: MKLIST(l,t); MKNODE(r1,l,r); r = r1;
3437: }
3438: MKLIST(*rp,r);
3439: }
3440: }
3441:
3442: void Pdp_mono_reduce(NODE arg,LIST *rp)
3443: {
3444: NODE t,t0,t1,r0,r;
3445: int i,n;
3446: DP m;
3447: DP *a;
3448:
3449: t0 = BDY((LIST)ARG0(arg));
3450: t1 = BDY((LIST)ARG1(arg));
3451: n = length(t0);
3452: a = (DP *)MALLOC(n*sizeof(DP));
3453: for ( i = 0; i < n; i++, t0 = NEXT(t0) ) a[i] = (DP)BDY(t0);
3454: for ( t = t1; t; t = NEXT(t) ) {
3455: m = (DP)BDY(t);
3456: for ( i = 0; i < n; i++ )
3457: if ( a[i] && dp_redble(a[i],m) ) a[i] = 0;
3458: }
3459: for ( i = n-1, r0 = 0; i >= 0; i-- )
3460: if ( a[i] ) { NEXTNODE(r0,r); BDY(r) = a[i]; }
3461: if ( r0 ) NEXT(r) = 0;
3462: MKLIST(*rp,r0);
3463: }
3464:
3465: #define BLEN (8*sizeof(unsigned long))
3466:
3467: void showmat2(unsigned long **a,int row,int col)
3468: {
3469: int i,j;
3470:
3471: for ( i = 0; i < row; i++, putchar('\n') )
3472: for ( j = 0; j < col; j++ )
3473: if ( a[i][j/BLEN] & (1L<<(j%BLEN)) ) putchar('1');
3474: else putchar('0');
3475: }
3476:
3477: int rref2(unsigned long **a,int row,int col)
3478: {
3479: int i,j,k,l,s,wcol,wj;
3480: unsigned long bj;
3481: unsigned long *ai,*ak,*as,*t;
3482: int *pivot;
3483:
3484: wcol = (col+BLEN-1)/BLEN;
3485: pivot = (int *)MALLOC_ATOMIC(row*sizeof(int));
3486: i = 0;
3487: for ( j = 0; j < col; j++ ) {
3488: wj = j/BLEN; bj = 1L<<(j%BLEN);
3489: for ( k = i; k < row; k++ )
3490: if ( a[k][wj] & bj ) break;
3491: if ( k == row ) continue;
3492: pivot[i] = j;
3493: if ( k != i ) {
3494: t = a[i]; a[i] = a[k]; a[k] = t;
3495: }
3496: ai = a[i];
3497: for ( k = i+1; k < row; k++ ) {
3498: ak = a[k];
3499: if ( ak[wj] & bj ) {
3500: for ( l = wj; l < wcol; l++ )
3501: ak[l] ^= ai[l];
3502: }
3503: }
3504: i++;
3505: }
3506: for ( k = i-1; k >= 0; k-- ) {
3507: j = pivot[k]; wj = j/BLEN; bj = 1L<<(j%BLEN);
3508: ak = a[k];
3509: for ( s = 0; s < k; s++ ) {
3510: as = a[s];
3511: if ( as[wj] & bj ) {
3512: for ( l = wj; l < wcol; l++ )
3513: as[l] ^= ak[l];
3514: }
3515: }
3516: }
3517: return i;
3518: }
3519:
3520: void Pdp_rref2(NODE arg,VECT *rp)
3521: {
3522: VECT f,term,ret;
3523: int row,col,wcol,size,nv,i,j,rank,td;
3524: unsigned long **mat;
3525: unsigned long *v;
3526: DL d;
3527: DL *t;
3528: DP dp;
3529: MP m,m0;
3530:
3531: f = (VECT)ARG0(arg);
3532: row = f->len;
3533: term = (VECT)ARG1(arg);
3534: col = term->len;
3535: mat = (unsigned long **)MALLOC(row*sizeof(unsigned long *));
3536: size = sizeof(unsigned long)*((col+BLEN-1)/BLEN);
3537: nv = ((DP)term->body[0])->nv;
3538: t = (DL *)MALLOC(col*sizeof(DL));
3539: for ( i = 0; i < col; i++ ) t[i] = BDY((DP)BDY(term)[i])->dl;
3540: for ( i = 0; i < row; i++ ) {
3541: v = mat[i] = (unsigned long *)MALLOC_ATOMIC_IGNORE_OFF_PAGE(size);
3542: bzero(v,size);
3543: for ( j = 0, m = BDY((DP)BDY(f)[i]); m; m = NEXT(m) ) {
3544: d = m->dl;
3545: for ( ; !dl_equal(nv,d,t[j]); j++ );
3546: v[j/BLEN] |= 1L <<(j%BLEN);
3547: }
3548: }
3549: rank = rref2(mat,row,col);
3550: MKVECT(ret,rank);
3551: *rp = ret;
3552: for ( i = 0; i < rank; i++ ) {
3553: v = mat[i];
3554: m0 = 0;
3555: td = 0;
3556: for ( j = 0; j < col; j++ ) {
3557: if ( v[j/BLEN] & (1L<<(j%BLEN)) ) {
3558: NEXTMP(m0,m);
3559: m->dl = t[j];
3560: m->c = (Obj)ONE;
3561: td = MAX(td,m->dl->td);
3562: }
3563: }
3564: NEXT(m) = 0;
3565: MKDP(nv,m0,dp);
3566: dp->sugar = td;
3567: BDY(ret)[i] = (pointer)dp;
3568: }
3569: }
3570:
3571: #define HDL(f) (BDY(f)->dl)
3572:
3573: NODE sumi_criB(int nv,NODE d,DP *f,int m)
3574: {
3575: LIST p;
3576: NODE r0,r;
3577: int p0,p1;
3578: DL p2,lcm;
3579:
3580: NEWDL(lcm,nv);
3581: r0 = 0;
3582: for ( ; d; d = NEXT(d) ) {
3583: p = (LIST)BDY(d);
1.2 noro 3584: p0 = ZTOS((Q)ARG0(BDY(p)));
3585: p1 = ZTOS((Q)ARG1(BDY(p)));
1.1 noro 3586: p2 = HDL((DP)ARG2(BDY(p)));
3587: if(!_dl_redble(HDL((DP)f[m]),p2,nv) ||
3588: dl_equal(nv,lcm_of_DL(nv,HDL(f[p0]),HDL(f[m]),lcm),p2) ||
3589: dl_equal(nv,lcm_of_DL(nv,HDL(f[p1]),HDL(f[m]),lcm),p2) ) {
3590: NEXTNODE(r0,r);
3591: BDY(r) = p;
3592: }
3593: }
3594: if ( r0 ) NEXT(r) = 0;
3595: return r0;
3596: }
3597:
3598: NODE sumi_criFMD(int nv,DP *f,int m)
3599: {
3600: DL *a;
3601: DL l1,dl1,dl2;
3602: int i,j,k,k2;
3603: NODE r,r1,nd;
3604: MP mp;
3605: DP u;
3606: Z iq,mq;
3607: LIST list;
3608:
3609: /* a[i] = lcm(LT(f[i]),LT(f[m])) */
3610: a = (DL *)ALLOCA(m*sizeof(DL));
3611: for ( i = 0; i < m; i++ ) {
3612: a[i] = lcm_of_DL(nv,HDL(f[i]),HDL(f[m]),0);
3613: }
3614: r = 0;
3615: for( i = 0; i < m; i++) {
3616: l1 = a[i];
3617: if ( !l1 ) continue;
3618: /* Tkm = Tim (k<i) */
3619: for( k = 0; k < i; k++)
3620: if( dl_equal(nv,l1,a[k]) ) break;
3621: if( k == i ){
3622: /* Tk|Tim && Tkm != Tim (k<m) */
3623: for ( k2 = 0; k2 < m; k2++ )
3624: if ( _dl_redble(HDL(f[k2]),l1,nv) &&
3625: !dl_equal(nv,l1,a[k2]) ) break;
3626: if ( k2 == m ) {
3627: dl1 = HDL(f[i]); dl2 = HDL(f[m]);
3628: for ( k2 = 0; k2 < nv; k2++ )
3629: if ( dl1->d[k2] && dl2->d[k2] ) break;
3630: if ( k2 < nv ) {
3631: NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE;
3632: NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td;
1.2 noro 3633: STOZ(i,iq); STOZ(m,mq);
1.1 noro 3634: nd = mknode(3,iq,mq,u);
3635: MKLIST(list,nd);
3636: MKNODE(r1,list,r);
3637: r = r1;
3638: }
3639: }
3640: }
3641: }
3642: return r;
3643: }
3644:
3645: LIST sumi_updatepairs(LIST d,DP *f,int m)
3646: {
3647: NODE old,new,t;
3648: LIST l;
3649: int nv;
3650:
3651: nv = f[0]->nv;
3652: old = sumi_criB(nv,BDY(d),f,m);
3653: new = sumi_criFMD(nv,f,m);
3654: if ( !new ) new = old;
3655: else {
3656: for ( t = new ; NEXT(t); t = NEXT(t) );
3657: NEXT(t) = old;
3658: }
3659: MKLIST(l,new);
3660: return l;
3661: }
3662:
3663: VECT ltov(LIST l)
3664: {
3665: NODE n;
3666: int i,len;
3667: VECT v;
3668:
3669: n = BDY(l);
3670: len = length(n);
3671: MKVECT(v,len);
3672: for ( i = 0; i < len; i++, n = NEXT(n) )
3673: BDY(v)[i] = BDY(n);
3674: return v;
3675: }
3676:
3677: DL subdl(int nv,DL d1,DL d2)
3678: {
3679: int i;
3680: DL d;
3681:
3682: NEWDL(d,nv);
3683: d->td = d1->td-d2->td;
3684: for ( i = 0; i < nv; i++ )
3685: d->d[i] = d1->d[i]-d2->d[i];
3686: return d;
3687: }
3688:
3689: DP dltodp(int nv,DL d)
3690: {
3691: MP mp;
3692: DP dp;
3693:
3694: NEWMP(mp); mp->dl = d; C(mp) = (Obj)ONE;
3695: NEXT(mp) = 0; MKDP(nv,mp,dp); dp->sugar = d->td;
3696: return dp;
3697: }
3698:
3699: LIST sumi_simplify(int nv,DL t,DP p,NODE f2,int simp)
3700: {
3701: DL d,h,hw;
3702: DP u,w,dp;
3703: int n,i,last;
3704: LIST *v;
3705: LIST list;
3706: NODE s,r;
3707:
3708: d = t; u = p;
3709: /* only the last history is used */
3710: if ( f2 && simp && t->td != 0 ) {
3711: adddl(nv,t,HDL(p),&h);
3712: n = length(f2);
3713: last = 1;
3714: if ( simp > 1 ) last = n;
3715: v = (LIST *)ALLOCA(n*sizeof(LIST));
3716: for ( r = f2, i = 0; r; r = NEXT(r), i++ ) v[n-i-1] = BDY(r);
3717: for ( i = 0; i < last; i++ ) {
3718: for ( s = BDY((LIST)v[i]); s; s = NEXT(s) ) {
3719: w = (DP)BDY(s); hw = HDL(w);
3720: if ( _dl_redble(hw,h,nv) ) {
3721: u = w;
3722: d = subdl(nv,h,hw);
3723: goto fin;
3724: }
3725: }
3726: }
3727: }
3728: fin:
3729: dp = dltodp(nv,d);
3730: r = mknode(2,dp,u);
3731: MKLIST(list,r);
3732: return list;
3733: }
3734:
3735: LIST sumi_symbolic(NODE l,int q,NODE f2,DP *g,int simp)
3736: {
3737: int nv;
3738: NODE t,r;
3739: NODE f0,f,fd0,fd,done0,done,red0,red;
3740: DL h,d;
3741: DP mul;
3742: int m;
3743: LIST tp,l0,l1,l2,l3,list;
3744: VECT v0,v1,v2,v3;
3745:
3746: nv = ((DP)BDY(l))->nv;
3747: t = 0;
3748:
3749: f0 = 0; fd0 = 0; done0 = 0; red0 = 0;
3750:
3751: for ( ; l; l = NEXT(l) ) {
3752: t = symb_merge(t,dp_dllist((DP)BDY(l)),nv);
3753: NEXTNODE(fd0,fd); BDY(fd) = BDY(l);
3754: }
3755:
3756: while ( t ) {
3757: h = (DL)BDY(t);
3758: NEXTNODE(done0,done); BDY(done) = dltodp(nv,h);
3759: t = NEXT(t);
3760: for(m = 0; m < q; m++)
3761: if ( _dl_redble(HDL(g[m]),h,nv) ) break;
3762: if ( m == q ) {
3763: } else {
3764: d = subdl(nv,h,HDL(g[m]));
3765: tp = sumi_simplify(nv,d,g[m],f2,simp);
3766:
3767: muldm(CO,ARG1(BDY(tp)),BDY((DP)ARG0(BDY(tp))),&mul);
3768: t = symb_merge(t,NEXT(dp_dllist(mul)),nv);
3769:
3770: NEXTNODE(f0,f); BDY(f) = tp;
3771: NEXTNODE(fd0,fd); BDY(fd) = mul;
3772: NEXTNODE(red0,red); BDY(red) = mul;
3773: }
3774: }
3775: if ( fd0 ) NEXT(fd) = 0; MKLIST(l0,fd0);
3776: v0 = ltov(l0);
3777: if ( done0 ) NEXT(done) = 0; MKLIST(l1,done0);
3778: v1 = ltov(l1);
3779: if ( f0 ) NEXT(f) = 0; MKLIST(l2,f0);
3780: v2 = ltov(l2);
3781: if ( red0 ) NEXT(red) = 0; MKLIST(l3,red0);
3782: v3 = ltov(l3);
3783: r = mknode(4,v0,v1,v2,v3);
3784: MKLIST(list,r);
3785: return list;
3786: }
3787:
3788: void Psumi_symbolic(NODE arg,LIST *rp)
3789: {
3790: NODE l,f2;
3791: DP *g;
3792: int q,simp;
3793:
3794: l = BDY((LIST)ARG0(arg));
1.2 noro 3795: q = ZTOS((Q)ARG1(arg));
1.1 noro 3796: f2 = BDY((LIST)ARG2(arg));
3797: g = (DP *)BDY((VECT)ARG3(arg));
1.2 noro 3798: simp = ZTOS((Q)ARG4(arg));
1.1 noro 3799: *rp = sumi_symbolic(l,q,f2,g,simp);
3800: }
3801:
3802: void Psumi_updatepairs(NODE arg,LIST *rp)
3803: {
3804: LIST d,l;
3805: DP *f;
3806: int m;
3807:
3808: d = (LIST)ARG0(arg);
3809: f = (DP *)BDY((VECT)ARG1(arg));
1.2 noro 3810: m = ZTOS((Q)ARG2(arg));
1.1 noro 3811: *rp = sumi_updatepairs(d,f,m);
3812: }
3813:
3814: LIST remove_zero_from_list(LIST l)
3815: {
3816: NODE n,r0,r;
3817: LIST rl;
3818:
3819: asir_assert(l,O_LIST,"remove_zero_from_list");
3820: n = BDY(l);
3821: for ( r0 = 0; n; n = NEXT(n) )
3822: if ( BDY(n) ) {
3823: NEXTNODE(r0,r);
3824: BDY(r) = BDY(n);
3825: }
3826: if ( r0 )
3827: NEXT(r) = 0;
3828: MKLIST(rl,r0);
3829: return rl;
3830: }
3831:
3832: int get_field_type(P p)
3833: {
3834: int type,t;
3835: DCP dc;
3836:
3837: if ( !p )
3838: return 0;
3839: else if ( NUM(p) )
3840: return NID((Num)p);
3841: else {
3842: type = 0;
3843: for ( dc = DC(p); dc; dc = NEXT(dc) ) {
3844: t = get_field_type(COEF(dc));
3845: if ( !t )
3846: continue;
3847: if ( t < 0 )
3848: return t;
3849: if ( !type )
3850: type = t;
3851: else if ( t != type )
3852: return -1;
3853: }
3854: return type;
3855: }
3856: }
3857:
3858: void Pdpv_ord(NODE arg,Obj *rp)
3859: {
3860: int ac,id;
3861: LIST shift;
3862:
3863: ac = argc(arg);
3864: if ( ac ) {
1.2 noro 3865: id = ZTOS((Q)ARG0(arg));
1.1 noro 3866: if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST )
3867: shift = (LIST)ARG1(arg);
3868: else
3869: shift = 0;
3870: create_modorder_spec(id,shift,&dp_current_modspec);
3871: }
3872: *rp = dp_current_modspec->obj;
3873: }
3874:
3875: extern int dpm_ispot;
3876:
3877: void Pdpm_ord(NODE arg,LIST *rp)
3878: {
3879: Z q;
3880: NODE nd;
3881: struct order_spec *spec;
3882:
3883: if ( arg ) {
3884: nd = BDY((LIST)ARG0(arg));
3885: if ( !create_order_spec(0,(Obj)ARG1(nd),&spec) )
3886: error("dpm_ord : invalid order specification");
1.2 noro 3887: initdpm(spec,ZTOS((Q)ARG0(nd)));
1.1 noro 3888: }
1.2 noro 3889: STOZ(dpm_ispot,q);
1.1 noro 3890: nd = mknode(2,q,dp_current_spec->obj);
3891: MKLIST(*rp,nd);
3892: }
3893:
3894: void Pdpm_hm(NODE arg,DPM *rp)
3895: {
3896: DPM p;
3897:
3898: p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_hm");
3899: dpm_hm(p,rp);
3900: }
3901:
3902: void Pdpm_ht(NODE arg,DPM *rp)
3903: {
3904: DPM p;
3905:
3906: p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dp_ht");
3907: dpm_ht(p,rp);
3908: }
3909:
3910: void Pdpm_hc(NODE arg,Obj *rp)
3911: {
3912: asir_assert(ARG0(arg),O_DPM,"dpm_hc");
3913: if ( !ARG0(arg) )
3914: *rp = 0;
3915: else
3916: *rp = BDY((DPM)ARG0(arg))->c;
3917: }
3918:
3919:
3920: void Pdpv_ht(NODE arg,LIST *rp)
3921: {
3922: NODE n;
3923: DP ht;
3924: int pos;
3925: DPV p;
3926: Z q;
3927:
3928: asir_assert(ARG0(arg),O_DPV,"dpv_ht");
3929: p = (DPV)ARG0(arg);
3930: pos = dpv_hp(p);
3931: if ( pos < 0 )
3932: ht = 0;
3933: else
3934: dp_ht(BDY(p)[pos],&ht);
1.2 noro 3935: STOZ(pos,q);
1.1 noro 3936: n = mknode(2,q,ht);
3937: MKLIST(*rp,n);
3938: }
3939:
3940: void Pdpv_hm(NODE arg,LIST *rp)
3941: {
3942: NODE n;
3943: DP ht;
3944: int pos;
3945: DPV p;
3946: Z q;
3947:
3948: asir_assert(ARG0(arg),O_DPV,"dpv_hm");
3949: p = (DPV)ARG0(arg);
3950: pos = dpv_hp(p);
3951: if ( pos < 0 )
3952: ht = 0;
3953: else
3954: dp_hm(BDY(p)[pos],&ht);
1.2 noro 3955: STOZ(pos,q);
1.1 noro 3956: n = mknode(2,q,ht);
3957: MKLIST(*rp,n);
3958: }
3959:
3960: void Pdpv_hc(NODE arg,LIST *rp)
3961: {
3962: NODE n;
3963: P hc;
3964: int pos;
3965: DPV p;
3966: Z q;
3967:
3968: asir_assert(ARG0(arg),O_DPV,"dpv_hc");
3969: p = (DPV)ARG0(arg);
3970: pos = dpv_hp(p);
3971: if ( pos < 0 )
3972: hc = 0;
3973: else
3974: hc = (P)BDY(BDY(p)[pos])->c;
1.2 noro 3975: STOZ(pos,q);
1.1 noro 3976: n = mknode(2,q,hc);
3977: MKLIST(*rp,n);
3978: }
3979:
3980: int dpv_hp(DPV p)
3981: {
3982: int len,i,maxp,maxw,w,slen;
3983: int *shift;
3984: DP *e;
3985:
3986: len = p->len;
3987: e = p->body;
3988: slen = dp_current_modspec->len;
3989: shift = dp_current_modspec->degree_shift;
3990: switch ( dp_current_modspec->id ) {
3991: case ORD_REVGRADLEX:
3992: for ( maxp = -1, i = 0; i < len; i++ )
3993: if ( !e[i] ) continue;
3994: else if ( maxp < 0 ) {
3995: maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;
3996: } else {
3997: w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);
3998: if ( w >= maxw ) {
3999: maxw = w; maxp = i;
4000: }
4001: }
4002: return maxp;
4003: case ORD_GRADLEX:
4004: for ( maxp = -1, i = 0; i < len; i++ )
4005: if ( !e[i] ) continue;
4006: else if ( maxp < 0 ) {
4007: maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;
4008: } else {
4009: w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);
4010: if ( w > maxw ) {
4011: maxw = w; maxp = i;
4012: }
4013: }
4014: return maxp;
4015: break;
4016: case ORD_LEX:
4017: for ( i = 0; i < len; i++ )
4018: if ( e[i] ) return i;
4019: return -1;
4020: break;
4021: }
4022: }
4023:
4024: int get_opt(char *key0,Obj *r) {
4025: NODE tt,p;
4026: char *key;
4027:
4028: if ( current_option ) {
4029: for ( tt = current_option; tt; tt = NEXT(tt) ) {
4030: p = BDY((LIST)BDY(tt));
4031: key = BDY((STRING)BDY(p));
4032: /* value = (Obj)BDY(NEXT(p)); */
4033: if ( !strcmp(key,key0) ) {
4034: *r = (Obj)BDY(NEXT(p));
4035: return 1;
4036: }
4037: }
4038: }
4039: return 0;
4040: }
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 / asir2018 / builtin