Annotation of OpenXM_contrib2/asir2000/builtin/dp.c, Revision 1.61
1.5 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.6 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.5 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.61 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.60 2005/08/25 18:59:11 ohara Exp $
1.5 noro 49: */
1.1 noro 50: #include "ca.h"
51: #include "base.h"
52: #include "parse.h"
53:
1.61 ! noro 54: extern int dp_fcoeffs;
1.8 noro 55: extern int dp_nelim;
56: extern int dp_order_pair_length;
57: extern struct order_pair *dp_order_pair;
1.46 noro 58: extern struct order_spec *dp_current_spec;
1.52 noro 59: extern struct modorder_spec *dp_current_modspec;
1.8 noro 60:
1.11 noro 61: int do_weyl;
1.1 noro 62:
1.44 noro 63: void Pdp_sort();
1.32 noro 64: void Pdp_mul_trunc(),Pdp_quo();
1.1 noro 65: void Pdp_ord(), Pdp_ptod(), Pdp_dtop();
66: void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
67: void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
1.30 ohara 68: void Pdp_set_sugar();
1.1 noro 69: void Pdp_cri1(),Pdp_cri2(),Pdp_subd(),Pdp_mod(),Pdp_red_mod(),Pdp_tdiv();
70: void Pdp_prim(),Pdp_red_coef(),Pdp_mag(),Pdp_set_kara(),Pdp_rat();
1.9 noro 71: void Pdp_nf(),Pdp_true_nf();
1.1 noro 72: void Pdp_nf_mod(),Pdp_true_nf_mod();
73: void Pdp_criB(),Pdp_nelim();
1.9 noro 74: void Pdp_minp(),Pdp_sp_mod();
1.1 noro 75: void Pdp_homo(),Pdp_dehomo();
1.16 noro 76: void Pdp_gr_mod_main(),Pdp_gr_f_main();
1.1 noro 77: void Pdp_gr_main(),Pdp_gr_hm_main(),Pdp_gr_d_main(),Pdp_gr_flags();
1.16 noro 78: void Pdp_f4_main(),Pdp_f4_mod_main(),Pdp_f4_f_main();
1.1 noro 79: void Pdp_gr_print();
1.28 noro 80: void Pdp_mbase(),Pdp_lnf_mod(),Pdp_nf_tab_mod(),Pdp_mdtod(), Pdp_nf_tab_f();
1.8 noro 81: void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), Pdp_sep();
82: void Pdp_cont();
1.22 noro 83: void Pdp_gr_checklist();
1.52 noro 84: void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc();
1.1 noro 85:
1.13 noro 86: void Pdp_weyl_red();
87: void Pdp_weyl_sp();
88: void Pdp_weyl_nf(),Pdp_weyl_nf_mod();
1.16 noro 89: void Pdp_weyl_gr_main(),Pdp_weyl_gr_mod_main(),Pdp_weyl_gr_f_main();
90: void Pdp_weyl_f4_main(),Pdp_weyl_f4_mod_main(),Pdp_weyl_f4_f_main();
1.13 noro 91: void Pdp_weyl_mul(),Pdp_weyl_mul_mod();
1.15 noro 92: void Pdp_weyl_set_weight();
1.24 noro 93: void Pdp_set_weight();
1.16 noro 94: void Pdp_nf_f(),Pdp_weyl_nf_f();
95: void Pdp_lnf_f();
1.40 noro 96: void Pnd_gr(),Pnd_gr_trace(),Pnd_f4();
1.58 noro 97: void Pnd_gr_postproc();
1.38 noro 98: void Pnd_weyl_gr(),Pnd_weyl_gr_trace();
1.39 noro 99: void Pnd_nf();
1.49 noro 100: void Pdp_initial_term();
101: void Pdp_order();
102:
103: LIST dp_initial_term();
104: LIST dp_order();
105: void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo,
106: int *modular,struct order_spec **ord);
1.11 noro 107:
1.25 noro 108: LIST remove_zero_from_list(LIST);
109:
1.1 noro 110: struct ftab dp_tab[] = {
1.8 noro 111: /* content reduction */
1.1 noro 112: {"dp_ptozp",Pdp_ptozp,1},
113: {"dp_ptozp2",Pdp_ptozp2,2},
114: {"dp_prim",Pdp_prim,1},
1.8 noro 115: {"dp_red_coef",Pdp_red_coef,2},
116: {"dp_cont",Pdp_cont,1},
117:
1.11 noro 118: /* polynomial ring */
1.32 noro 119: /* special operations */
120: {"dp_mul_trunc",Pdp_mul_trunc,3},
121: {"dp_quo",Pdp_quo,2},
122:
1.8 noro 123: /* s-poly */
124: {"dp_sp",Pdp_sp,2},
125: {"dp_sp_mod",Pdp_sp_mod,3},
126:
127: /* m-reduction */
1.1 noro 128: {"dp_red",Pdp_red,3},
129: {"dp_red_mod",Pdp_red_mod,4},
1.8 noro 130:
131: /* normal form */
1.1 noro 132: {"dp_nf",Pdp_nf,4},
1.16 noro 133: {"dp_nf_f",Pdp_nf_f,4},
1.1 noro 134: {"dp_true_nf",Pdp_true_nf,4},
135: {"dp_nf_mod",Pdp_nf_mod,5},
136: {"dp_true_nf_mod",Pdp_true_nf_mod,5},
1.8 noro 137: {"dp_lnf_mod",Pdp_lnf_mod,3},
1.28 noro 138: {"dp_nf_tab_f",Pdp_nf_tab_f,2},
1.8 noro 139: {"dp_nf_tab_mod",Pdp_nf_tab_mod,3},
1.16 noro 140: {"dp_lnf_f",Pdp_lnf_f,2},
1.8 noro 141:
142: /* Buchberger algorithm */
1.46 noro 143: {"dp_gr_main",Pdp_gr_main,-5},
1.1 noro 144: {"dp_gr_mod_main",Pdp_gr_mod_main,5},
1.27 noro 145: {"dp_gr_f_main",Pdp_gr_f_main,4},
1.23 noro 146: {"dp_gr_checklist",Pdp_gr_checklist,2},
1.40 noro 147: {"nd_f4",Pnd_f4,4},
1.33 noro 148: {"nd_gr",Pnd_gr,4},
1.36 noro 149: {"nd_gr_trace",Pnd_gr_trace,5},
1.58 noro 150: {"nd_gr_postproc",Pnd_gr_postproc,5},
1.38 noro 151: {"nd_weyl_gr",Pnd_weyl_gr,4},
152: {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5},
1.39 noro 153: {"nd_nf",Pnd_nf,5},
1.8 noro 154:
155: /* F4 algorithm */
1.1 noro 156: {"dp_f4_main",Pdp_f4_main,3},
157: {"dp_f4_mod_main",Pdp_f4_mod_main,4},
1.8 noro 158:
1.11 noro 159: /* weyl algebra */
1.12 noro 160: /* multiplication */
161: {"dp_weyl_mul",Pdp_weyl_mul,2},
1.13 noro 162: {"dp_weyl_mul_mod",Pdp_weyl_mul_mod,3},
1.12 noro 163:
1.11 noro 164: /* s-poly */
165: {"dp_weyl_sp",Pdp_weyl_sp,2},
166:
167: /* m-reduction */
168: {"dp_weyl_red",Pdp_weyl_red,3},
169:
170: /* normal form */
171: {"dp_weyl_nf",Pdp_weyl_nf,4},
1.13 noro 172: {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},
1.16 noro 173: {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},
1.11 noro 174:
175: /* Buchberger algorithm */
1.50 noro 176: {"dp_weyl_gr_main",Pdp_weyl_gr_main,-5},
1.11 noro 177: {"dp_weyl_gr_mod_main",Pdp_weyl_gr_mod_main,5},
1.16 noro 178: {"dp_weyl_gr_f_main",Pdp_weyl_gr_f_main,4},
1.11 noro 179:
180: /* F4 algorithm */
181: {"dp_weyl_f4_main",Pdp_weyl_f4_main,3},
1.19 noro 182: {"dp_weyl_f4_mod_main",Pdp_weyl_f4_mod_main,4},
1.11 noro 183:
1.15 noro 184: /* misc */
1.24 noro 185: {"dp_set_weight",Pdp_set_weight,-1},
1.15 noro 186: {"dp_weyl_set_weight",Pdp_weyl_set_weight,-1},
1.8 noro 187: {0,0,0},
188: };
189:
190: struct ftab dp_supp_tab[] = {
191: /* setting flags */
1.44 noro 192: {"dp_sort",Pdp_sort,1},
1.8 noro 193: {"dp_ord",Pdp_ord,-1},
1.52 noro 194: {"dpv_ord",Pdpv_ord,-2},
1.8 noro 195: {"dp_set_kara",Pdp_set_kara,-1},
196: {"dp_nelim",Pdp_nelim,-1},
1.1 noro 197: {"dp_gr_flags",Pdp_gr_flags,-1},
198: {"dp_gr_print",Pdp_gr_print,-1},
1.8 noro 199:
200: /* converters */
1.53 noro 201: {"dp_ptod",Pdp_ptod,-2},
1.8 noro 202: {"dp_dtop",Pdp_dtop,2},
203: {"dp_homo",Pdp_homo,1},
204: {"dp_dehomo",Pdp_dehomo,1},
205: {"dp_etov",Pdp_etov,1},
206: {"dp_vtoe",Pdp_vtoe,1},
207: {"dp_dtov",Pdp_dtov,1},
208: {"dp_mdtod",Pdp_mdtod,1},
209: {"dp_mod",Pdp_mod,3},
210: {"dp_rat",Pdp_rat,1},
1.53 noro 211: {"dp_ltod",Pdp_ltod,-2},
1.8 noro 212:
213: /* criteria */
214: {"dp_cri1",Pdp_cri1,2},
215: {"dp_cri2",Pdp_cri2,2},
216: {"dp_criB",Pdp_criB,3},
217:
218: /* simple operation */
219: {"dp_subd",Pdp_subd,2},
220: {"dp_lcm",Pdp_lcm,2},
221: {"dp_hm",Pdp_hm,1},
222: {"dp_ht",Pdp_ht,1},
223: {"dp_hc",Pdp_hc,1},
1.52 noro 224: {"dpv_hm",Pdpv_hm,1},
225: {"dpv_ht",Pdpv_ht,1},
226: {"dpv_hc",Pdpv_hc,1},
1.8 noro 227: {"dp_rest",Pdp_rest,1},
1.49 noro 228: {"dp_initial_term",Pdp_initial_term,1},
229: {"dp_order",Pdp_order,1},
1.8 noro 230:
231: /* degree and size */
232: {"dp_td",Pdp_td,1},
233: {"dp_mag",Pdp_mag,1},
234: {"dp_sugar",Pdp_sugar,1},
1.30 ohara 235: {"dp_set_sugar",Pdp_set_sugar,2},
1.8 noro 236:
237: /* misc */
238: {"dp_mbase",Pdp_mbase,1},
239: {"dp_redble",Pdp_redble,2},
240: {"dp_sep",Pdp_sep,2},
241: {"dp_idiv",Pdp_idiv,2},
242: {"dp_tdiv",Pdp_tdiv,2},
243: {"dp_minp",Pdp_minp,2},
244:
245: {0,0,0}
1.1 noro 246: };
1.44 noro 247:
248: void Pdp_sort(arg,rp)
249: NODE arg;
250: DP *rp;
251: {
252: dp_sort((DP)ARG0(arg),rp);
253: }
1.1 noro 254:
1.8 noro 255: void Pdp_mdtod(arg,rp)
256: NODE arg;
257: DP *rp;
258: {
259: MP m,mr,mr0;
260: DP p;
261: P t;
262:
263: p = (DP)ARG0(arg);
264: if ( !p )
265: *rp = 0;
266: else {
267: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
268: mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;
269: }
270: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
271: }
272: }
273:
274: void Pdp_sep(arg,rp)
275: NODE arg;
276: VECT *rp;
277: {
278: DP p,r;
279: MP m,t;
280: MP *w0,*w;
281: int i,n,d,nv,sugar;
282: VECT v;
283: pointer *pv;
284:
285: p = (DP)ARG0(arg); m = BDY(p);
286: d = QTOS((Q)ARG1(arg));
287: for ( t = m, n = 0; t; t = NEXT(t), n++ );
288: if ( d > n )
289: d = n;
290: MKVECT(v,d); *rp = v;
291: pv = BDY(v); nv = p->nv; sugar = p->sugar;
292: w0 = (MP *)MALLOC(d*sizeof(MP)); bzero(w0,d*sizeof(MP));
293: w = (MP *)MALLOC(d*sizeof(MP)); bzero(w,d*sizeof(MP));
294: for ( t = BDY(p), i = 0; t; t = NEXT(t), i++, i %= d ) {
295: NEXTMP(w0[i],w[i]); w[i]->c = t->c; w[i]->dl = t->dl;
296: }
297: for ( i = 0; i < d; i++ ) {
298: NEXT(w[i]) = 0; MKDP(nv,w0[i],r); r->sugar = sugar;
299: pv[i] = (pointer)r;
300: }
301: }
302:
303: void Pdp_idiv(arg,rp)
304: NODE arg;
305: DP *rp;
306: {
307: dp_idiv((DP)ARG0(arg),(Q)ARG1(arg),rp);
308: }
309:
310: void Pdp_cont(arg,rp)
311: NODE arg;
312: Q *rp;
313: {
314: dp_cont((DP)ARG0(arg),rp);
315: }
316:
317: void Pdp_dtov(arg,rp)
318: NODE arg;
319: VECT *rp;
320: {
321: dp_dtov((DP)ARG0(arg),rp);
322: }
323:
324: void Pdp_mbase(arg,rp)
325: NODE arg;
326: LIST *rp;
327: {
328: NODE mb;
329:
330: asir_assert(ARG0(arg),O_LIST,"dp_mbase");
331: dp_mbase(BDY((LIST)ARG0(arg)),&mb);
332: MKLIST(*rp,mb);
333: }
334:
335: void Pdp_etov(arg,rp)
336: NODE arg;
337: VECT *rp;
338: {
339: DP dp;
340: int n,i;
341: int *d;
342: VECT v;
343: Q t;
344:
345: dp = (DP)ARG0(arg);
346: asir_assert(dp,O_DP,"dp_etov");
347: n = dp->nv; d = BDY(dp)->dl->d;
348: MKVECT(v,n);
349: for ( i = 0; i < n; i++ ) {
350: STOQ(d[i],t); v->body[i] = (pointer)t;
351: }
352: *rp = v;
353: }
354:
355: void Pdp_vtoe(arg,rp)
356: NODE arg;
357: DP *rp;
358: {
359: DP dp;
360: DL dl;
361: MP m;
362: int n,i,td;
363: int *d;
364: VECT v;
365:
366: v = (VECT)ARG0(arg);
367: asir_assert(v,O_VECT,"dp_vtoe");
368: n = v->len;
369: NEWDL(dl,n); d = dl->d;
370: for ( i = 0, td = 0; i < n; i++ ) {
1.24 noro 371: d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i);
1.8 noro 372: }
373: dl->td = td;
374: NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;
375: MKDP(n,m,dp); dp->sugar = td;
376: *rp = dp;
377: }
378:
379: void Pdp_lnf_mod(arg,rp)
380: NODE arg;
381: LIST *rp;
382: {
383: DP r1,r2;
384: NODE b,g,n;
385: int mod;
386:
387: asir_assert(ARG0(arg),O_LIST,"dp_lnf_mod");
388: asir_assert(ARG1(arg),O_LIST,"dp_lnf_mod");
389: asir_assert(ARG2(arg),O_N,"dp_lnf_mod");
390: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
391: mod = QTOS((Q)ARG2(arg));
392: dp_lnf_mod((DP)BDY(b),(DP)BDY(NEXT(b)),g,mod,&r1,&r2);
393: NEWNODE(n); BDY(n) = (pointer)r1;
394: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
395: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
396: }
397:
1.16 noro 398: void Pdp_lnf_f(arg,rp)
399: NODE arg;
400: LIST *rp;
401: {
402: DP r1,r2;
403: NODE b,g,n;
404:
405: asir_assert(ARG0(arg),O_LIST,"dp_lnf_f");
406: asir_assert(ARG1(arg),O_LIST,"dp_lnf_f");
407: b = BDY((LIST)ARG0(arg)); g = BDY((LIST)ARG1(arg));
408: dp_lnf_f((DP)BDY(b),(DP)BDY(NEXT(b)),g,&r1,&r2);
409: NEWNODE(n); BDY(n) = (pointer)r1;
410: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r2;
411: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
412: }
413:
1.8 noro 414: void Pdp_nf_tab_mod(arg,rp)
415: NODE arg;
416: DP *rp;
417: {
418: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_mod");
419: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_mod");
420: asir_assert(ARG2(arg),O_N,"dp_nf_tab_mod");
421: dp_nf_tab_mod((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),
422: QTOS((Q)ARG2(arg)),rp);
1.28 noro 423: }
424:
425: void Pdp_nf_tab_f(arg,rp)
426: NODE arg;
427: DP *rp;
428: {
429: asir_assert(ARG0(arg),O_DP,"dp_nf_tab_f");
430: asir_assert(ARG1(arg),O_VECT,"dp_nf_tab_f");
431: dp_nf_tab_f((DP)ARG0(arg),(LIST *)BDY((VECT)ARG1(arg)),rp);
1.8 noro 432: }
1.1 noro 433:
434: void Pdp_ord(arg,rp)
435: NODE arg;
436: Obj *rp;
437: {
1.46 noro 438: struct order_spec *spec;
1.51 noro 439: LIST v;
440: struct oLIST f;
441: Num homo;
442: int modular;
443:
444: f.id = O_LIST; f.body = 0;
1.59 noro 445: if ( !arg && !current_option )
1.46 noro 446: *rp = dp_current_spec->obj;
1.1 noro 447: else {
1.53 noro 448: if ( current_option )
449: parse_gr_option(&f,current_option,&v,&homo,&modular,&spec);
1.51 noro 450: else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) )
451: error("dp_ord : invalid order specification");
1.46 noro 452: initd(spec); *rp = spec->obj;
1.1 noro 453: }
454: }
455:
456: void Pdp_ptod(arg,rp)
457: NODE arg;
458: DP *rp;
459: {
1.53 noro 460: P p;
1.1 noro 461: NODE n;
462: VL vl,tvl;
1.53 noro 463: struct oLIST f;
464: int ac;
465: LIST v;
466: Num homo;
467: int modular;
468: struct order_spec *ord;
1.1 noro 469:
470: asir_assert(ARG0(arg),O_P,"dp_ptod");
1.53 noro 471: p = (P)ARG0(arg);
472: ac = argc(arg);
473: if ( ac == 1 ) {
474: if ( current_option ) {
475: f.id = O_LIST; f.body = mknode(1,p);
476: parse_gr_option(&f,current_option,&v,&homo,&modular,&ord);
1.54 noro 477: initd(ord);
1.53 noro 478: } else
479: error("dp_ptod : invalid argument");
480: } else {
481: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
482: v = (LIST)ARG1(arg);
483: }
484: for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1.1 noro 485: if ( !vl ) {
486: NEWVL(vl); tvl = vl;
487: } else {
488: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
489: }
490: VR(tvl) = VR((P)BDY(n));
491: }
492: if ( vl )
493: NEXT(tvl) = 0;
1.53 noro 494: ptod(CO,vl,p,rp);
1.1 noro 495: }
496:
1.52 noro 497: void Pdp_ltod(arg,rp)
498: NODE arg;
499: DPV *rp;
500: {
501: NODE n;
502: VL vl,tvl;
1.53 noro 503: LIST f,v;
504: int sugar,i,len,ac,modular;
505: Num homo;
506: struct order_spec *ord;
1.52 noro 507: DP *e;
508: NODE nd,t;
509:
1.53 noro 510: ac = argc(arg);
1.52 noro 511: asir_assert(ARG0(arg),O_LIST,"dp_ptod");
1.53 noro 512: f = (LIST)ARG0(arg);
513: if ( ac == 1 ) {
514: if ( current_option ) {
515: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.54 noro 516: initd(ord);
1.53 noro 517: } else
518: error("dp_ltod : invalid argument");
519: } else {
520: asir_assert(ARG1(arg),O_LIST,"dp_ptod");
521: v = (LIST)ARG1(arg);
522: }
523: for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
1.52 noro 524: if ( !vl ) {
525: NEWVL(vl); tvl = vl;
526: } else {
527: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
528: }
529: VR(tvl) = VR((P)BDY(n));
530: }
531: if ( vl )
532: NEXT(tvl) = 0;
1.53 noro 533:
534: nd = BDY(f);
1.52 noro 535: len = length(nd);
536: e = (DP *)MALLOC(len*sizeof(DP));
537: sugar = 0;
538: for ( i = 0, t = nd; i < len; i++, t = NEXT(t) ) {
539: ptod(CO,vl,(P)BDY(t),&e[i]);
540: if ( e[i] )
541: sugar = MAX(sugar,e[i]->sugar);
542: }
543: MKDPV(len,e,*rp);
544: }
545:
1.1 noro 546: void Pdp_dtop(arg,rp)
547: NODE arg;
548: P *rp;
549: {
550: NODE n;
551: VL vl,tvl;
552:
553: asir_assert(ARG0(arg),O_DP,"dp_dtop");
554: asir_assert(ARG1(arg),O_LIST,"dp_dtop");
555: for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
556: if ( !vl ) {
557: NEWVL(vl); tvl = vl;
558: } else {
559: NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
560: }
561: VR(tvl) = VR((P)BDY(n));
562: }
563: if ( vl )
564: NEXT(tvl) = 0;
565: dtop(CO,vl,(DP)ARG0(arg),rp);
566: }
567:
568: extern LIST Dist;
569:
570: void Pdp_ptozp(arg,rp)
571: NODE arg;
1.60 ohara 572: Obj *rp;
1.1 noro 573: {
1.60 ohara 574: Q t;
575: NODE tt,p;
576: NODE n,n0;
577: char *key;
578: DP pp;
579: LIST list;
580: int get_factor=0;
581:
1.1 noro 582: asir_assert(ARG0(arg),O_DP,"dp_ptozp");
1.60 ohara 583:
584: /* analyze the option */
585: if ( current_option ) {
586: for ( tt = current_option; tt; tt = NEXT(tt) ) {
587: p = BDY((LIST)BDY(tt));
588: key = BDY((STRING)BDY(p));
589: /* value = (Obj)BDY(NEXT(p)); */
590: if ( !strcmp(key,"factor") ) get_factor=1;
591: else {
592: error("ptozp: unknown option.");
593: }
594: }
595: }
596:
597: dp_ptozp3((DP)ARG0(arg),&t,&pp);
598:
599: /* printexpr(NULL,t); */
600: /* if the option factor is given, then it returns the answer
601: in the format [zpoly, num] where num*zpoly is equal to the argument.*/
602: if (get_factor) {
603: n0 = mknode(2,pp,t);
604: MKLIST(list,n0);
605: *rp = (Obj)list;
606: } else
607: *rp = (Obj)pp;
1.1 noro 608: }
609:
610: void Pdp_ptozp2(arg,rp)
611: NODE arg;
612: LIST *rp;
613: {
614: DP p0,p1,h,r;
615: NODE n0;
616:
617: p0 = (DP)ARG0(arg); p1 = (DP)ARG1(arg);
618: asir_assert(p0,O_DP,"dp_ptozp2");
619: asir_assert(p1,O_DP,"dp_ptozp2");
1.10 noro 620: dp_ptozp2(p0,p1,&h,&r);
1.1 noro 621: NEWNODE(n0); BDY(n0) = (pointer)h;
622: NEWNODE(NEXT(n0)); BDY(NEXT(n0)) = (pointer)r;
623: NEXT(NEXT(n0)) = 0;
624: MKLIST(*rp,n0);
625: }
626:
627: void Pdp_prim(arg,rp)
628: NODE arg;
629: DP *rp;
630: {
631: DP t;
632:
633: asir_assert(ARG0(arg),O_DP,"dp_prim");
634: dp_prim((DP)ARG0(arg),&t); dp_ptozp(t,rp);
635: }
636:
637: void Pdp_mod(arg,rp)
638: NODE arg;
639: DP *rp;
640: {
641: DP p;
642: int mod;
643: NODE subst;
644:
645: asir_assert(ARG0(arg),O_DP,"dp_mod");
646: asir_assert(ARG1(arg),O_N,"dp_mod");
647: asir_assert(ARG2(arg),O_LIST,"dp_mod");
648: p = (DP)ARG0(arg); mod = QTOS((Q)ARG1(arg));
649: subst = BDY((LIST)ARG2(arg));
650: dp_mod(p,mod,subst,rp);
651: }
652:
653: void Pdp_rat(arg,rp)
654: NODE arg;
655: DP *rp;
656: {
657: asir_assert(ARG0(arg),O_DP,"dp_rat");
658: dp_rat((DP)ARG0(arg),rp);
659: }
660:
1.9 noro 661: extern int DP_Multiple;
662:
1.1 noro 663: void Pdp_nf(arg,rp)
664: NODE arg;
665: DP *rp;
666: {
667: NODE b;
668: DP *ps;
669: DP g;
670: int full;
671:
1.61 ! noro 672: do_weyl = 0; dp_fcoeffs = 0;
1.1 noro 673: asir_assert(ARG0(arg),O_LIST,"dp_nf");
674: asir_assert(ARG1(arg),O_DP,"dp_nf");
675: asir_assert(ARG2(arg),O_VECT,"dp_nf");
676: asir_assert(ARG3(arg),O_N,"dp_nf");
677: if ( !(g = (DP)ARG1(arg)) ) {
678: *rp = 0; return;
679: }
680: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
681: full = (Q)ARG3(arg) ? 1 : 0;
1.16 noro 682: dp_nf_z(b,g,ps,full,DP_Multiple,rp);
1.1 noro 683: }
684:
1.11 noro 685: void Pdp_weyl_nf(arg,rp)
686: NODE arg;
687: DP *rp;
688: {
689: NODE b;
690: DP *ps;
691: DP g;
692: int full;
693:
694: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf");
695: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf");
696: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf");
697: asir_assert(ARG3(arg),O_N,"dp_weyl_nf");
698: if ( !(g = (DP)ARG1(arg)) ) {
699: *rp = 0; return;
700: }
701: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
702: full = (Q)ARG3(arg) ? 1 : 0;
1.12 noro 703: do_weyl = 1;
1.16 noro 704: dp_nf_z(b,g,ps,full,DP_Multiple,rp);
705: do_weyl = 0;
706: }
707:
708: /* nf computation using field operations */
709:
710: void Pdp_nf_f(arg,rp)
711: NODE arg;
712: DP *rp;
713: {
714: NODE b;
715: DP *ps;
716: DP g;
717: int full;
718:
719: do_weyl = 0;
720: asir_assert(ARG0(arg),O_LIST,"dp_nf_f");
721: asir_assert(ARG1(arg),O_DP,"dp_nf_f");
722: asir_assert(ARG2(arg),O_VECT,"dp_nf_f");
723: asir_assert(ARG3(arg),O_N,"dp_nf_f");
724: if ( !(g = (DP)ARG1(arg)) ) {
725: *rp = 0; return;
726: }
727: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
728: full = (Q)ARG3(arg) ? 1 : 0;
729: dp_nf_f(b,g,ps,full,rp);
730: }
731:
732: void Pdp_weyl_nf_f(arg,rp)
733: NODE arg;
734: DP *rp;
735: {
736: NODE b;
737: DP *ps;
738: DP g;
739: int full;
740:
741: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_f");
742: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_f");
743: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_f");
744: asir_assert(ARG3(arg),O_N,"dp_weyl_nf_f");
745: if ( !(g = (DP)ARG1(arg)) ) {
746: *rp = 0; return;
747: }
748: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
749: full = (Q)ARG3(arg) ? 1 : 0;
750: do_weyl = 1;
751: dp_nf_f(b,g,ps,full,rp);
1.12 noro 752: do_weyl = 0;
1.11 noro 753: }
754:
1.13 noro 755: void Pdp_nf_mod(arg,rp)
756: NODE arg;
757: DP *rp;
758: {
759: NODE b;
760: DP g;
761: DP *ps;
762: int mod,full,ac;
763: NODE n,n0;
764:
1.14 noro 765: do_weyl = 0;
1.13 noro 766: ac = argc(arg);
1.14 noro 767: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
768: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
769: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
770: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
771: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
1.13 noro 772: if ( !(g = (DP)ARG1(arg)) ) {
773: *rp = 0; return;
774: }
775: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
776: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
777: for ( n0 = n = 0; b; b = NEXT(b) ) {
778: NEXTNODE(n0,n);
779: BDY(n) = (pointer)QTOS((Q)BDY(b));
780: }
781: if ( n0 )
782: NEXT(n) = 0;
783: dp_nf_mod(n0,g,ps,mod,full,rp);
784: }
785:
1.1 noro 786: void Pdp_true_nf(arg,rp)
787: NODE arg;
788: LIST *rp;
789: {
790: NODE b,n;
791: DP *ps;
792: DP g;
793: DP nm;
794: P dn;
795: int full;
796:
1.61 ! noro 797: do_weyl = 0; dp_fcoeffs = 0;
1.1 noro 798: asir_assert(ARG0(arg),O_LIST,"dp_true_nf");
799: asir_assert(ARG1(arg),O_DP,"dp_true_nf");
800: asir_assert(ARG2(arg),O_VECT,"dp_true_nf");
801: asir_assert(ARG3(arg),O_N,"dp_nf");
802: if ( !(g = (DP)ARG1(arg)) ) {
803: nm = 0; dn = (P)ONE;
804: } else {
805: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
806: full = (Q)ARG3(arg) ? 1 : 0;
807: dp_true_nf(b,g,ps,full,&nm,&dn);
808: }
809: NEWNODE(n); BDY(n) = (pointer)nm;
810: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
811: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
812: }
813:
1.13 noro 814: void Pdp_weyl_nf_mod(arg,rp)
1.8 noro 815: NODE arg;
816: DP *rp;
817: {
818: NODE b;
819: DP g;
820: DP *ps;
821: int mod,full,ac;
1.9 noro 822: NODE n,n0;
1.8 noro 823:
824: ac = argc(arg);
1.14 noro 825: asir_assert(ARG0(arg),O_LIST,"dp_weyl_nf_mod");
826: asir_assert(ARG1(arg),O_DP,"dp_weyl_nf_mod");
827: asir_assert(ARG2(arg),O_VECT,"dp_weyl_nf_mod");
828: asir_assert(ARG3(arg),O_N,"dp_weyl_nf_mod");
829: asir_assert(ARG4(arg),O_N,"dp_weyl_nf_mod");
1.8 noro 830: if ( !(g = (DP)ARG1(arg)) ) {
831: *rp = 0; return;
832: }
833: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
834: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
1.9 noro 835: for ( n0 = n = 0; b; b = NEXT(b) ) {
836: NEXTNODE(n0,n);
837: BDY(n) = (pointer)QTOS((Q)BDY(b));
838: }
839: if ( n0 )
840: NEXT(n) = 0;
1.13 noro 841: do_weyl = 1;
842: dp_nf_mod(n0,g,ps,mod,full,rp);
843: do_weyl = 0;
1.8 noro 844: }
845:
846: void Pdp_true_nf_mod(arg,rp)
847: NODE arg;
848: LIST *rp;
849: {
850: NODE b;
851: DP g,nm;
852: P dn;
853: DP *ps;
854: int mod,full;
855: NODE n;
856:
1.11 noro 857: do_weyl = 0;
1.8 noro 858: asir_assert(ARG0(arg),O_LIST,"dp_nf_mod");
859: asir_assert(ARG1(arg),O_DP,"dp_nf_mod");
860: asir_assert(ARG2(arg),O_VECT,"dp_nf_mod");
861: asir_assert(ARG3(arg),O_N,"dp_nf_mod");
862: asir_assert(ARG4(arg),O_N,"dp_nf_mod");
863: if ( !(g = (DP)ARG1(arg)) ) {
864: nm = 0; dn = (P)ONEM;
865: } else {
866: b = BDY((LIST)ARG0(arg)); ps = (DP *)BDY((VECT)ARG2(arg));
867: full = QTOS((Q)ARG3(arg)); mod = QTOS((Q)ARG4(arg));
868: dp_true_nf_mod(b,g,ps,mod,full,&nm,&dn);
869: }
870: NEWNODE(n); BDY(n) = (pointer)nm;
871: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)dn;
872: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1.1 noro 873: }
874:
875: void Pdp_tdiv(arg,rp)
876: NODE arg;
877: DP *rp;
878: {
879: MP m,mr,mr0;
880: DP p;
881: Q c;
882: N d,q,r;
883: int sgn;
884:
885: asir_assert(ARG0(arg),O_DP,"dp_tdiv");
886: asir_assert(ARG1(arg),O_N,"dp_tdiv");
887: p = (DP)ARG0(arg); d = NM((Q)ARG1(arg)); sgn = SGN((Q)ARG1(arg));
888: if ( !p )
889: *rp = 0;
890: else {
891: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
892: divn(NM((Q)m->c),d,&q,&r);
893: if ( r ) {
894: *rp = 0; return;
895: } else {
896: NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
897: mr->c = (P)c; mr->dl = m->dl;
898: }
899: }
900: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
901: }
902: }
903:
904: void Pdp_red_coef(arg,rp)
905: NODE arg;
906: DP *rp;
907: {
908: MP m,mr,mr0;
909: P q,r;
910: DP p;
911: P mod;
912:
913: p = (DP)ARG0(arg); mod = (P)ARG1(arg);
914: asir_assert(p,O_DP,"dp_red_coef");
915: asir_assert(mod,O_P,"dp_red_coef");
916: if ( !p )
917: *rp = 0;
918: else {
919: for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
920: divsrp(CO,m->c,mod,&q,&r);
921: if ( r ) {
922: NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;
923: }
924: }
925: if ( mr0 ) {
926: NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
927: } else
928: *rp = 0;
929: }
930: }
931:
932: void Pdp_redble(arg,rp)
933: NODE arg;
934: Q *rp;
935: {
936: asir_assert(ARG0(arg),O_DP,"dp_redble");
937: asir_assert(ARG1(arg),O_DP,"dp_redble");
938: if ( dp_redble((DP)ARG0(arg),(DP)ARG1(arg)) )
939: *rp = ONE;
940: else
941: *rp = 0;
942: }
943:
944: void Pdp_red_mod(arg,rp)
945: NODE arg;
946: LIST *rp;
947: {
948: DP h,r;
949: P dmy;
950: NODE n;
951:
1.11 noro 952: do_weyl = 0;
1.1 noro 953: asir_assert(ARG0(arg),O_DP,"dp_red_mod");
954: asir_assert(ARG1(arg),O_DP,"dp_red_mod");
955: asir_assert(ARG2(arg),O_DP,"dp_red_mod");
956: asir_assert(ARG3(arg),O_N,"dp_red_mod");
957: dp_red_mod((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),QTOS((Q)ARG3(arg)),
958: &h,&r,&dmy);
959: NEWNODE(n); BDY(n) = (pointer)h;
960: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)r;
961: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
962: }
1.13 noro 963:
1.1 noro 964: void Pdp_subd(arg,rp)
965: NODE arg;
966: DP *rp;
967: {
968: DP p1,p2;
969:
970: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
971: asir_assert(p1,O_DP,"dp_subd");
972: asir_assert(p2,O_DP,"dp_subd");
973: dp_subd(p1,p2,rp);
974: }
975:
1.32 noro 976: void Pdp_mul_trunc(arg,rp)
977: NODE arg;
978: DP *rp;
979: {
980: DP p1,p2,p;
981:
982: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg);
983: asir_assert(p1,O_DP,"dp_mul_trunc");
984: asir_assert(p2,O_DP,"dp_mul_trunc");
985: asir_assert(p,O_DP,"dp_mul_trunc");
986: comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp);
987: }
988:
989: void Pdp_quo(arg,rp)
990: NODE arg;
991: DP *rp;
992: {
993: DP p1,p2;
994:
995: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
996: asir_assert(p1,O_DP,"dp_quo");
997: asir_assert(p2,O_DP,"dp_quo");
998: comm_quod(CO,p1,p2,rp);
999: }
1000:
1.12 noro 1001: void Pdp_weyl_mul(arg,rp)
1002: NODE arg;
1003: DP *rp;
1004: {
1005: DP p1,p2;
1006:
1007: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1.32 noro 1008: asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul");
1.12 noro 1009: do_weyl = 1;
1010: muld(CO,p1,p2,rp);
1.13 noro 1011: do_weyl = 0;
1012: }
1013:
1014: void Pdp_weyl_mul_mod(arg,rp)
1015: NODE arg;
1016: DP *rp;
1017: {
1018: DP p1,p2;
1019: Q m;
1020:
1021: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); m = (Q)ARG2(arg);
1022: asir_assert(p1,O_DP,"dp_weyl_mul_mod");
1023: asir_assert(p2,O_DP,"dp_mul_mod");
1024: asir_assert(m,O_N,"dp_mul_mod");
1025: do_weyl = 1;
1026: mulmd(CO,QTOS(m),p1,p2,rp);
1.12 noro 1027: do_weyl = 0;
1028: }
1029:
1.1 noro 1030: void Pdp_red(arg,rp)
1031: NODE arg;
1032: LIST *rp;
1033: {
1034: NODE n;
1.4 noro 1035: DP head,rest,dmy1;
1.1 noro 1036: P dmy;
1037:
1.11 noro 1038: do_weyl = 0;
1.1 noro 1039: asir_assert(ARG0(arg),O_DP,"dp_red");
1040: asir_assert(ARG1(arg),O_DP,"dp_red");
1041: asir_assert(ARG2(arg),O_DP,"dp_red");
1.4 noro 1042: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.1 noro 1043: NEWNODE(n); BDY(n) = (pointer)head;
1044: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
1045: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1046: }
1047:
1.11 noro 1048: void Pdp_weyl_red(arg,rp)
1049: NODE arg;
1050: LIST *rp;
1051: {
1052: NODE n;
1053: DP head,rest,dmy1;
1054: P dmy;
1055:
1056: asir_assert(ARG0(arg),O_DP,"dp_weyl_red");
1057: asir_assert(ARG1(arg),O_DP,"dp_weyl_red");
1058: asir_assert(ARG2(arg),O_DP,"dp_weyl_red");
1.12 noro 1059: do_weyl = 1;
1.11 noro 1060: dp_red((DP)ARG0(arg),(DP)ARG1(arg),(DP)ARG2(arg),&head,&rest,&dmy,&dmy1);
1.12 noro 1061: do_weyl = 0;
1.11 noro 1062: NEWNODE(n); BDY(n) = (pointer)head;
1063: NEWNODE(NEXT(n)); BDY(NEXT(n)) = (pointer)rest;
1064: NEXT(NEXT(n)) = 0; MKLIST(*rp,n);
1065: }
1066:
1.1 noro 1067: void Pdp_sp(arg,rp)
1068: NODE arg;
1069: DP *rp;
1070: {
1071: DP p1,p2;
1072:
1.11 noro 1073: do_weyl = 0;
1.1 noro 1074: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1075: asir_assert(p1,O_DP,"dp_sp"); asir_assert(p2,O_DP,"dp_sp");
1076: dp_sp(p1,p2,rp);
1077: }
1078:
1.11 noro 1079: void Pdp_weyl_sp(arg,rp)
1080: NODE arg;
1081: DP *rp;
1082: {
1083: DP p1,p2;
1084:
1085: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1086: asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");
1.12 noro 1087: do_weyl = 1;
1.11 noro 1088: dp_sp(p1,p2,rp);
1.12 noro 1089: do_weyl = 0;
1.11 noro 1090: }
1091:
1.1 noro 1092: void Pdp_sp_mod(arg,rp)
1093: NODE arg;
1094: DP *rp;
1095: {
1096: DP p1,p2;
1097: int mod;
1098:
1.11 noro 1099: do_weyl = 0;
1.1 noro 1100: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1101: asir_assert(p1,O_DP,"dp_sp_mod"); asir_assert(p2,O_DP,"dp_sp_mod");
1102: asir_assert(ARG2(arg),O_N,"dp_sp_mod");
1103: mod = QTOS((Q)ARG2(arg));
1104: dp_sp_mod(p1,p2,mod,rp);
1105: }
1106:
1107: void Pdp_lcm(arg,rp)
1108: NODE arg;
1109: DP *rp;
1110: {
1111: int i,n,td;
1112: DL d1,d2,d;
1113: MP m;
1114: DP p1,p2;
1115:
1116: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1117: asir_assert(p1,O_DP,"dp_lcm"); asir_assert(p2,O_DP,"dp_lcm");
1118: n = p1->nv; d1 = BDY(p1)->dl; d2 = BDY(p2)->dl;
1119: NEWDL(d,n);
1120: for ( i = 0, td = 0; i < n; i++ ) {
1.24 noro 1121: d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i);
1.1 noro 1122: }
1123: d->td = td;
1124: NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;
1125: MKDP(n,m,*rp); (*rp)->sugar = td; /* XXX */
1126: }
1127:
1128: void Pdp_hm(arg,rp)
1129: NODE arg;
1130: DP *rp;
1131: {
1132: DP p;
1133:
1134: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_hm");
1135: dp_hm(p,rp);
1136: }
1137:
1138: void Pdp_ht(arg,rp)
1139: NODE arg;
1140: DP *rp;
1141: {
1142: DP p;
1143: MP m,mr;
1144:
1145: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_ht");
1.52 noro 1146: dp_ht(p,rp);
1.1 noro 1147: }
1148:
1149: void Pdp_hc(arg,rp)
1150: NODE arg;
1151: P *rp;
1152: {
1153: asir_assert(ARG0(arg),O_DP,"dp_hc");
1154: if ( !ARG0(arg) )
1155: *rp = 0;
1156: else
1157: *rp = BDY((DP)ARG0(arg))->c;
1158: }
1159:
1160: void Pdp_rest(arg,rp)
1161: NODE arg;
1162: DP *rp;
1163: {
1164: asir_assert(ARG0(arg),O_DP,"dp_rest");
1165: if ( !ARG0(arg) )
1166: *rp = 0;
1167: else
1168: dp_rest((DP)ARG0(arg),rp);
1169: }
1170:
1171: void Pdp_td(arg,rp)
1172: NODE arg;
1173: Q *rp;
1174: {
1175: DP p;
1176:
1177: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_td");
1178: if ( !p )
1179: *rp = 0;
1180: else
1181: STOQ(BDY(p)->dl->td,*rp);
1182: }
1183:
1184: void Pdp_sugar(arg,rp)
1185: NODE arg;
1186: Q *rp;
1187: {
1188: DP p;
1189:
1190: p = (DP)ARG0(arg); asir_assert(p,O_DP,"dp_sugar");
1191: if ( !p )
1192: *rp = 0;
1193: else
1194: STOQ(p->sugar,*rp);
1.30 ohara 1195: }
1196:
1.49 noro 1197: void Pdp_initial_term(arg,rp)
1198: NODE arg;
1199: Obj *rp;
1200: {
1201: struct order_spec *ord;
1202: Num homo;
1203: int modular,is_list;
1204: LIST v,f,l,initiallist;
1205: NODE n;
1206:
1207: f = (LIST)ARG0(arg);
1208: if ( f && OID(f) == O_LIST )
1209: is_list = 1;
1210: else {
1211: n = mknode(1,f); MKLIST(l,n); f = l;
1212: is_list = 0;
1213: }
1.54 noro 1214: if ( current_option ) {
1.53 noro 1215: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.54 noro 1216: initd(ord);
1217: } else
1.49 noro 1218: ord = dp_current_spec;
1219: initiallist = dp_initial_term(f,ord);
1220: if ( !is_list )
1221: *rp = (Obj)BDY(BDY(initiallist));
1222: else
1223: *rp = (Obj)initiallist;
1224: }
1225:
1226: void Pdp_order(arg,rp)
1227: NODE arg;
1228: Obj *rp;
1229: {
1230: struct order_spec *ord;
1231: Num homo;
1232: int modular,is_list;
1233: LIST v,f,l,ordlist;
1234: NODE n;
1235:
1236: f = (LIST)ARG0(arg);
1237: if ( f && OID(f) == O_LIST )
1238: is_list = 1;
1239: else {
1240: n = mknode(1,f); MKLIST(l,n); f = l;
1241: is_list = 0;
1242: }
1.54 noro 1243: if ( current_option ) {
1.53 noro 1244: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.54 noro 1245: initd(ord);
1246: } else
1.49 noro 1247: ord = dp_current_spec;
1248: ordlist = dp_order(f,ord);
1249: if ( !is_list )
1250: *rp = (Obj)BDY(BDY(ordlist));
1251: else
1252: *rp = (Obj)ordlist;
1253: }
1254:
1.30 ohara 1255: void Pdp_set_sugar(arg,rp)
1256: NODE arg;
1257: Q *rp;
1258: {
1259: DP p;
1260: Q q;
1261: int i;
1262:
1263: p = (DP)ARG0(arg);
1264: q = (Q)ARG1(arg);
1265: if ( p && q) {
1266: asir_assert(p,O_DP,"dp_set_sugar");
1267: asir_assert(q,O_N, "dp_set_sugar");
1268: i = QTOS(q);
1269: if (p->sugar < i) {
1270: p->sugar = i;
1271: }
1272: }
1273: *rp = 0;
1.1 noro 1274: }
1275:
1276: void Pdp_cri1(arg,rp)
1277: NODE arg;
1278: Q *rp;
1279: {
1280: DP p1,p2;
1281: int *d1,*d2;
1282: int i,n;
1283:
1284: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1285: asir_assert(p1,O_DP,"dp_cri1"); asir_assert(p2,O_DP,"dp_cri1");
1286: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
1287: for ( i = 0; i < n; i++ )
1288: if ( d1[i] > d2[i] )
1289: break;
1290: *rp = i == n ? ONE : 0;
1291: }
1292:
1293: void Pdp_cri2(arg,rp)
1294: NODE arg;
1295: Q *rp;
1296: {
1297: DP p1,p2;
1298: int *d1,*d2;
1299: int i,n;
1300:
1301: p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
1302: asir_assert(p1,O_DP,"dp_cri2"); asir_assert(p2,O_DP,"dp_cri2");
1303: n = p1->nv; d1 = BDY(p1)->dl->d; d2 = BDY(p2)->dl->d;
1304: for ( i = 0; i < n; i++ )
1305: if ( MIN(d1[i],d2[i]) >= 1 )
1306: break;
1307: *rp = i == n ? ONE : 0;
1308: }
1309:
1310: void Pdp_minp(arg,rp)
1311: NODE arg;
1312: LIST *rp;
1313: {
1314: NODE tn,tn1,d,dd,dd0,p,tp;
1315: LIST l,minp;
1316: DP lcm,tlcm;
1317: int s,ts;
1318:
1319: asir_assert(ARG0(arg),O_LIST,"dp_minp");
1320: d = BDY((LIST)ARG0(arg)); minp = (LIST)BDY(d);
1321: p = BDY(minp); p = NEXT(NEXT(p)); lcm = (DP)BDY(p); p = NEXT(p);
1322: if ( !ARG1(arg) ) {
1323: s = QTOS((Q)BDY(p)); p = NEXT(p);
1324: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
1325: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
1326: tlcm = (DP)BDY(tp); tp = NEXT(tp);
1327: ts = QTOS((Q)BDY(tp)); tp = NEXT(tp);
1328: NEXTNODE(dd0,dd);
1329: if ( ts < s ) {
1330: BDY(dd) = (pointer)minp;
1331: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
1332: } else if ( ts == s ) {
1333: if ( compd(CO,lcm,tlcm) > 0 ) {
1334: BDY(dd) = (pointer)minp;
1335: minp = (LIST)BDY(d); lcm = tlcm; s = ts;
1336: } else
1337: BDY(dd) = BDY(d);
1338: } else
1339: BDY(dd) = BDY(d);
1340: }
1341: } else {
1342: for ( dd0 = 0, d = NEXT(d); d; d = NEXT(d) ) {
1343: tp = BDY((LIST)BDY(d)); tp = NEXT(NEXT(tp));
1344: tlcm = (DP)BDY(tp);
1345: NEXTNODE(dd0,dd);
1346: if ( compd(CO,lcm,tlcm) > 0 ) {
1347: BDY(dd) = (pointer)minp; minp = (LIST)BDY(d); lcm = tlcm;
1348: } else
1349: BDY(dd) = BDY(d);
1350: }
1351: }
1352: if ( dd0 )
1353: NEXT(dd) = 0;
1354: MKLIST(l,dd0); MKNODE(tn,l,0); MKNODE(tn1,minp,tn); MKLIST(*rp,tn1);
1355: }
1356:
1357: void Pdp_criB(arg,rp)
1358: NODE arg;
1359: LIST *rp;
1360: {
1361: NODE d,ij,dd,ddd;
1362: int i,j,s,n;
1363: DP *ps;
1364: DL ts,ti,tj,lij,tdl;
1365:
1366: asir_assert(ARG0(arg),O_LIST,"dp_criB"); d = BDY((LIST)ARG0(arg));
1367: asir_assert(ARG1(arg),O_N,"dp_criB"); s = QTOS((Q)ARG1(arg));
1368: asir_assert(ARG2(arg),O_VECT,"dp_criB"); ps = (DP *)BDY((VECT)ARG2(arg));
1369: if ( !d )
1370: *rp = (LIST)ARG0(arg);
1371: else {
1372: ts = BDY(ps[s])->dl;
1373: n = ps[s]->nv;
1374: NEWDL(tdl,n);
1375: for ( dd = 0; d; d = NEXT(d) ) {
1376: ij = BDY((LIST)BDY(d));
1377: i = QTOS((Q)BDY(ij)); ij = NEXT(ij);
1378: j = QTOS((Q)BDY(ij)); ij = NEXT(ij);
1379: lij = BDY((DP)BDY(ij))->dl;
1380: ti = BDY(ps[i])->dl; tj = BDY(ps[j])->dl;
1381: if ( lij->td != lcm_of_DL(n,lij,ts,tdl)->td
1382: || !dl_equal(n,lij,tdl)
1383: || (lij->td == lcm_of_DL(n,ti,ts,tdl)->td
1384: && dl_equal(n,tdl,lij))
1385: || (lij->td == lcm_of_DL(n,tj,ts,tdl)->td
1386: && dl_equal(n,tdl,lij)) ) {
1387: MKNODE(ddd,BDY(d),dd);
1388: dd = ddd;
1389: }
1390: }
1391: MKLIST(*rp,dd);
1392: }
1393: }
1394:
1395: void Pdp_nelim(arg,rp)
1396: NODE arg;
1397: Q *rp;
1398: {
1399: if ( arg ) {
1400: asir_assert(ARG0(arg),O_N,"dp_nelim");
1401: dp_nelim = QTOS((Q)ARG0(arg));
1402: }
1403: STOQ(dp_nelim,*rp);
1404: }
1405:
1406: void Pdp_mag(arg,rp)
1407: NODE arg;
1408: Q *rp;
1409: {
1410: DP p;
1411: int s;
1412: MP m;
1413:
1414: p = (DP)ARG0(arg);
1415: asir_assert(p,O_DP,"dp_mag");
1416: if ( !p )
1417: *rp = 0;
1418: else {
1419: for ( s = 0, m = BDY(p); m; m = NEXT(m) )
1420: s += p_mag(m->c);
1421: STOQ(s,*rp);
1422: }
1423: }
1424:
1425: extern int kara_mag;
1426:
1427: void Pdp_set_kara(arg,rp)
1428: NODE arg;
1429: Q *rp;
1430: {
1431: if ( arg ) {
1432: asir_assert(ARG0(arg),O_N,"dp_set_kara");
1433: kara_mag = QTOS((Q)ARG0(arg));
1434: }
1435: STOQ(kara_mag,*rp);
1436: }
1437:
1438: void Pdp_homo(arg,rp)
1439: NODE arg;
1440: DP *rp;
1441: {
1442: asir_assert(ARG0(arg),O_DP,"dp_homo");
1443: dp_homo((DP)ARG0(arg),rp);
1444: }
1445:
1.8 noro 1446: void Pdp_dehomo(arg,rp)
1447: NODE arg;
1.1 noro 1448: DP *rp;
1449: {
1.8 noro 1450: asir_assert(ARG0(arg),O_DP,"dp_dehomo");
1451: dp_dehomo((DP)ARG0(arg),rp);
1452: }
1453:
1454: void Pdp_gr_flags(arg,rp)
1455: NODE arg;
1456: LIST *rp;
1457: {
1458: Obj name,value;
1459: NODE n;
1.1 noro 1460:
1.8 noro 1461: if ( arg ) {
1462: asir_assert(ARG0(arg),O_LIST,"dp_gr_flags");
1463: n = BDY((LIST)ARG0(arg));
1464: while ( n ) {
1465: name = (Obj)BDY(n); n = NEXT(n);
1466: if ( !n )
1467: break;
1468: else {
1469: value = (Obj)BDY(n); n = NEXT(n);
1470: }
1471: dp_set_flag(name,value);
1.1 noro 1472: }
1473: }
1.8 noro 1474: dp_make_flaglist(rp);
1475: }
1476:
1.29 noro 1477: extern int DP_Print, DP_PrintShort;
1.8 noro 1478:
1479: void Pdp_gr_print(arg,rp)
1480: NODE arg;
1481: Q *rp;
1482: {
1483: Q q;
1.29 noro 1484: int s;
1.8 noro 1485:
1486: if ( arg ) {
1487: asir_assert(ARG0(arg),O_N,"dp_gr_print");
1.29 noro 1488: q = (Q)ARG0(arg);
1489: s = QTOS(q);
1490: switch ( s ) {
1491: case 0:
1492: DP_Print = 0; DP_PrintShort = 0;
1493: break;
1494: case 1:
1495: DP_Print = 1;
1496: break;
1.41 noro 1497: case 2:
1.29 noro 1498: DP_Print = 0; DP_PrintShort = 1;
1.43 noro 1499: break;
1.41 noro 1500: default:
1501: DP_Print = s; DP_PrintShort = 0;
1.29 noro 1502: break;
1503: }
1504: } else {
1505: if ( DP_Print ) {
1506: STOQ(1,q);
1507: } else if ( DP_PrintShort ) {
1508: STOQ(2,q);
1509: } else
1510: q = 0;
1511: }
1.8 noro 1512: *rp = q;
1.1 noro 1513: }
1514:
1.46 noro 1515: void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo,
1516: int *modular,struct order_spec **ord)
1517: {
1518: NODE t,p;
1519: Q m;
1520: char *key;
1521: Obj value,dmy;
1522: int ord_is_set = 0;
1523: int modular_is_set = 0;
1524: int homo_is_set = 0;
1.47 noro 1525: VL vl,vl0;
1.46 noro 1526: LIST vars;
1.47 noro 1527: char xiname[BUFSIZ];
1528: NODE x0,x;
1529: DP d;
1530: P xi;
1531: int nv,i;
1.46 noro 1532:
1533: /* extract vars */
1534: vars = 0;
1535: for ( t = opt; t; t = NEXT(t) ) {
1536: p = BDY((LIST)BDY(t));
1537: key = BDY((STRING)BDY(p));
1538: value = (Obj)BDY(NEXT(p));
1539: if ( !strcmp(key,"v") ) {
1540: /* variable list */
1541: vars = (LIST)value;
1542: break;
1543: }
1544: }
1.48 noro 1545: if ( vars ) {
1546: *v = vars; pltovl(vars,&vl);
1547: } else {
1548: for ( t = BDY(f); t; t = NEXT(t) )
1549: if ( BDY(t) && OID((Obj)BDY(t))==O_DP )
1550: break;
1551: if ( t ) {
1552: /* f is DP list */
1553: /* create dummy var list */
1554: d = (DP)BDY(t);
1555: nv = NV(d);
1556: for ( i = 0, vl0 = 0, x0 = 0; i < nv; i++ ) {
1557: NEXTVL(vl0,vl);
1558: NEXTNODE(x0,x);
1559: sprintf(xiname,"x%d",i);
1560: makevar(xiname,&xi);
1561: x->body = (pointer)xi;
1562: vl->v = VR((P)xi);
1563: }
1564: if ( vl0 ) {
1565: NEXT(vl) = 0;
1566: NEXT(x) = 0;
1567: }
1568: MKLIST(vars,x0);
1569: *v = vars;
1570: vl = vl0;
1571: } else {
1572: get_vars((Obj)f,&vl); vltopl(vl,v);
1.47 noro 1573: }
1.46 noro 1574: }
1575:
1576: for ( t = opt; t; t = NEXT(t) ) {
1577: p = BDY((LIST)BDY(t));
1578: key = BDY((STRING)BDY(p));
1579: value = (Obj)BDY(NEXT(p));
1580: if ( !strcmp(key,"v") ) {
1581: /* variable list; ignore */
1582: } else if ( !strcmp(key,"order") ) {
1583: /* order spec */
1.51 noro 1584: if ( !vl )
1585: error("parse_gr_option : variables must be specified");
1.46 noro 1586: create_order_spec(vl,value,ord);
1587: ord_is_set = 1;
1588: } else if ( !strcmp(key,"block") ) {
1589: create_order_spec(0,value,ord);
1.51 noro 1590: ord_is_set = 1;
1.46 noro 1591: } else if ( !strcmp(key,"matrix") ) {
1592: create_order_spec(0,value,ord);
1.51 noro 1593: ord_is_set = 1;
1.46 noro 1594: } else if ( !strcmp(key,"sugarweight") ) {
1595: /* weight */
1596: Pdp_set_weight(NEXT(p),&dmy);
1597: } else if ( !strcmp(key,"homo") ) {
1598: *homo = (Num)value;
1599: homo_is_set = 1;
1600: } else if ( !strcmp(key,"trace") ) {
1601: m = (Q)value;
1602: if ( !m )
1603: *modular = 0;
1604: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1
1605: && BD(NM(m))[0] >= 0x80000000) )
1606: error("parse_gr_option : too large modulus");
1607: else
1608: *modular = QTOS(m);
1609: modular_is_set = 1;
1610: } else
1611: error("parse_gr_option : not implemented");
1612: }
1613: if ( !ord_is_set ) create_order_spec(0,0,ord);
1614: if ( !modular_is_set ) *modular = 0;
1615: if ( !homo_is_set ) *homo = 0;
1616: }
1617:
1.8 noro 1618: void Pdp_gr_main(arg,rp)
1.1 noro 1619: NODE arg;
1.8 noro 1620: LIST *rp;
1.1 noro 1621: {
1.8 noro 1622: LIST f,v;
1.46 noro 1623: VL vl;
1.8 noro 1624: Num homo;
1625: Q m;
1.46 noro 1626: int modular,ac;
1627: struct order_spec *ord;
1.8 noro 1628:
1.11 noro 1629: do_weyl = 0;
1.8 noro 1630: asir_assert(ARG0(arg),O_LIST,"dp_gr_main");
1.46 noro 1631: f = (LIST)ARG0(arg);
1.25 noro 1632: f = remove_zero_from_list(f);
1633: if ( !BDY(f) ) {
1634: *rp = f; return;
1635: }
1.53 noro 1636: if ( (ac = argc(arg)) == 5 ) {
1.46 noro 1637: asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
1638: asir_assert(ARG2(arg),O_N,"dp_gr_main");
1639: asir_assert(ARG3(arg),O_N,"dp_gr_main");
1.49 noro 1640: v = (LIST)ARG1(arg);
1.46 noro 1641: homo = (Num)ARG2(arg);
1642: m = (Q)ARG3(arg);
1643: if ( !m )
1644: modular = 0;
1645: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
1646: error("dp_gr_main : too large modulus");
1647: else
1648: modular = QTOS(m);
1649: create_order_spec(0,ARG4(arg),&ord);
1.53 noro 1650: } else if ( current_option )
1651: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.46 noro 1652: else if ( ac == 1 )
1653: parse_gr_option(f,0,&v,&homo,&modular,&ord);
1.8 noro 1654: else
1.46 noro 1655: error("dp_gr_main : invalid argument");
1656: dp_gr_main(f,v,homo,modular,0,ord,rp);
1.16 noro 1657: }
1658:
1659: void Pdp_gr_f_main(arg,rp)
1660: NODE arg;
1661: LIST *rp;
1662: {
1663: LIST f,v;
1664: Num homo;
1.26 noro 1665: int m,field,t;
1.46 noro 1666: struct order_spec *ord;
1.26 noro 1667: NODE n;
1.16 noro 1668:
1669: do_weyl = 0;
1670: asir_assert(ARG0(arg),O_LIST,"dp_gr_f_main");
1671: asir_assert(ARG1(arg),O_LIST,"dp_gr_f_main");
1672: asir_assert(ARG2(arg),O_N,"dp_gr_f_main");
1673: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1674: f = remove_zero_from_list(f);
1675: if ( !BDY(f) ) {
1676: *rp = f; return;
1677: }
1.16 noro 1678: homo = (Num)ARG2(arg);
1.27 noro 1679: #if 0
1680: asir_assert(ARG3(arg),O_N,"dp_gr_f_main");
1.26 noro 1681: m = QTOS((Q)ARG3(arg));
1682: if ( m )
1683: error("dp_gr_f_main : trace lifting is not implemented yet");
1.46 noro 1684: create_order_spec(0,ARG4(arg),&ord);
1.27 noro 1685: #else
1686: m = 0;
1.46 noro 1687: create_order_spec(0,ARG3(arg),&ord);
1.27 noro 1688: #endif
1.26 noro 1689: field = 0;
1690: for ( n = BDY(f); n; n = NEXT(n) ) {
1691: t = get_field_type(BDY(n));
1692: if ( !t )
1693: continue;
1694: if ( t < 0 )
1695: error("dp_gr_f_main : incosistent coefficients");
1696: if ( !field )
1697: field = t;
1698: else if ( t != field )
1699: error("dp_gr_f_main : incosistent coefficients");
1700: }
1.46 noro 1701: dp_gr_main(f,v,homo,m?1:0,field,ord,rp);
1.1 noro 1702: }
1703:
1.8 noro 1704: void Pdp_f4_main(arg,rp)
1705: NODE arg;
1706: LIST *rp;
1.1 noro 1707: {
1.8 noro 1708: LIST f,v;
1.46 noro 1709: struct order_spec *ord;
1.1 noro 1710:
1.11 noro 1711: do_weyl = 0;
1.8 noro 1712: asir_assert(ARG0(arg),O_LIST,"dp_f4_main");
1713: asir_assert(ARG1(arg),O_LIST,"dp_f4_main");
1714: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1715: f = remove_zero_from_list(f);
1716: if ( !BDY(f) ) {
1717: *rp = f; return;
1718: }
1.46 noro 1719: create_order_spec(0,ARG2(arg),&ord);
1720: dp_f4_main(f,v,ord,rp);
1.22 noro 1721: }
1722:
1723: /* dp_gr_checklist(list of dp) */
1724:
1725: void Pdp_gr_checklist(arg,rp)
1726: NODE arg;
1727: LIST *rp;
1728: {
1729: VECT g;
1730: LIST dp;
1731: NODE r;
1.23 noro 1732: int n;
1.22 noro 1733:
1734: do_weyl = 0;
1735: asir_assert(ARG0(arg),O_LIST,"dp_gr_checklist");
1.23 noro 1736: asir_assert(ARG1(arg),O_N,"dp_gr_checklist");
1737: n = QTOS((Q)ARG1(arg));
1738: gbcheck_list(BDY((LIST)ARG0(arg)),n,&g,&dp);
1.22 noro 1739: r = mknode(2,g,dp);
1740: MKLIST(*rp,r);
1.1 noro 1741: }
1742:
1.8 noro 1743: void Pdp_f4_mod_main(arg,rp)
1744: NODE arg;
1745: LIST *rp;
1.1 noro 1746: {
1.8 noro 1747: LIST f,v;
1748: int m;
1.46 noro 1749: struct order_spec *ord;
1.8 noro 1750:
1.11 noro 1751: do_weyl = 0;
1.17 noro 1752: asir_assert(ARG0(arg),O_LIST,"dp_f4_mod_main");
1753: asir_assert(ARG1(arg),O_LIST,"dp_f4_mod_main");
1754: asir_assert(ARG2(arg),O_N,"dp_f4_mod_main");
1.8 noro 1755: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1.25 noro 1756: f = remove_zero_from_list(f);
1757: if ( !BDY(f) ) {
1758: *rp = f; return;
1759: }
1.20 noro 1760: if ( !m )
1761: error("dp_f4_mod_main : invalid argument");
1.46 noro 1762: create_order_spec(0,ARG3(arg),&ord);
1763: dp_f4_mod_main(f,v,m,ord,rp);
1.8 noro 1764: }
1.1 noro 1765:
1.8 noro 1766: void Pdp_gr_mod_main(arg,rp)
1767: NODE arg;
1768: LIST *rp;
1769: {
1770: LIST f,v;
1771: Num homo;
1772: int m;
1.46 noro 1773: struct order_spec *ord;
1.8 noro 1774:
1.11 noro 1775: do_weyl = 0;
1.8 noro 1776: asir_assert(ARG0(arg),O_LIST,"dp_gr_mod_main");
1777: asir_assert(ARG1(arg),O_LIST,"dp_gr_mod_main");
1778: asir_assert(ARG2(arg),O_N,"dp_gr_mod_main");
1779: asir_assert(ARG3(arg),O_N,"dp_gr_mod_main");
1.11 noro 1780: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 1781: f = remove_zero_from_list(f);
1782: if ( !BDY(f) ) {
1783: *rp = f; return;
1784: }
1.11 noro 1785: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1.20 noro 1786: if ( !m )
1787: error("dp_gr_mod_main : invalid argument");
1.46 noro 1788: create_order_spec(0,ARG4(arg),&ord);
1789: dp_gr_mod_main(f,v,homo,m,ord,rp);
1.33 noro 1790: }
1791:
1.40 noro 1792: void Pnd_f4(arg,rp)
1793: NODE arg;
1794: LIST *rp;
1795: {
1796: LIST f,v;
1797: int m,homo;
1.46 noro 1798: struct order_spec *ord;
1.40 noro 1799:
1800: do_weyl = 0;
1801: asir_assert(ARG0(arg),O_LIST,"nd_gr");
1802: asir_assert(ARG1(arg),O_LIST,"nd_gr");
1803: asir_assert(ARG2(arg),O_N,"nd_gr");
1804: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1805: f = remove_zero_from_list(f);
1806: if ( !BDY(f) ) {
1807: *rp = f; return;
1808: }
1809: m = QTOS((Q)ARG2(arg));
1.46 noro 1810: create_order_spec(0,ARG3(arg),&ord);
1811: nd_gr(f,v,m,1,ord,rp);
1.40 noro 1812: }
1813:
1.33 noro 1814: void Pnd_gr(arg,rp)
1815: NODE arg;
1816: LIST *rp;
1817: {
1818: LIST f,v;
1.36 noro 1819: int m,homo;
1.46 noro 1820: struct order_spec *ord;
1.33 noro 1821:
1822: do_weyl = 0;
1823: asir_assert(ARG0(arg),O_LIST,"nd_gr");
1824: asir_assert(ARG1(arg),O_LIST,"nd_gr");
1.36 noro 1825: asir_assert(ARG2(arg),O_N,"nd_gr");
1.33 noro 1826: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1827: f = remove_zero_from_list(f);
1828: if ( !BDY(f) ) {
1829: *rp = f; return;
1830: }
1831: m = QTOS((Q)ARG2(arg));
1.46 noro 1832: create_order_spec(0,ARG3(arg),&ord);
1833: nd_gr(f,v,m,0,ord,rp);
1.58 noro 1834: }
1835:
1836: void Pnd_gr_postproc(arg,rp)
1837: NODE arg;
1838: LIST *rp;
1839: {
1840: LIST f,v;
1841: int m,do_check;
1842: struct order_spec *ord;
1843:
1844: do_weyl = 0;
1845: asir_assert(ARG0(arg),O_LIST,"nd_gr");
1846: asir_assert(ARG1(arg),O_LIST,"nd_gr");
1847: asir_assert(ARG2(arg),O_N,"nd_gr");
1848: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1849: f = remove_zero_from_list(f);
1850: if ( !BDY(f) ) {
1851: *rp = f; return;
1852: }
1853: m = QTOS((Q)ARG2(arg));
1854: create_order_spec(0,ARG3(arg),&ord);
1855: do_check = ARG4(arg) ? 1 : 0;
1856: nd_gr_postproc(f,v,m,ord,do_check,rp);
1.36 noro 1857: }
1858:
1859: void Pnd_gr_trace(arg,rp)
1860: NODE arg;
1861: LIST *rp;
1862: {
1863: LIST f,v;
1864: int m,homo;
1.46 noro 1865: struct order_spec *ord;
1.36 noro 1866:
1867: do_weyl = 0;
1868: asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");
1869: asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");
1870: asir_assert(ARG2(arg),O_N,"nd_gr_trace");
1871: asir_assert(ARG3(arg),O_N,"nd_gr_trace");
1872: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1873: f = remove_zero_from_list(f);
1874: if ( !BDY(f) ) {
1875: *rp = f; return;
1876: }
1877: homo = QTOS((Q)ARG2(arg));
1878: m = QTOS((Q)ARG3(arg));
1.46 noro 1879: create_order_spec(0,ARG4(arg),&ord);
1880: nd_gr_trace(f,v,m,homo,ord,rp);
1.11 noro 1881: }
1882:
1.38 noro 1883: void Pnd_weyl_gr(arg,rp)
1884: NODE arg;
1885: LIST *rp;
1886: {
1887: LIST f,v;
1888: int m,homo;
1.46 noro 1889: struct order_spec *ord;
1.38 noro 1890:
1891: do_weyl = 1;
1892: asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr");
1893: asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr");
1894: asir_assert(ARG2(arg),O_N,"nd_weyl_gr");
1895: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1896: f = remove_zero_from_list(f);
1897: if ( !BDY(f) ) {
1898: *rp = f; return;
1899: }
1900: m = QTOS((Q)ARG2(arg));
1.46 noro 1901: create_order_spec(0,ARG3(arg),&ord);
1902: nd_gr(f,v,m,0,ord,rp);
1.38 noro 1903: }
1904:
1905: void Pnd_weyl_gr_trace(arg,rp)
1906: NODE arg;
1907: LIST *rp;
1908: {
1909: LIST f,v;
1910: int m,homo;
1.46 noro 1911: struct order_spec *ord;
1.38 noro 1912:
1913: do_weyl = 1;
1914: asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace");
1915: asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace");
1916: asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace");
1917: asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace");
1918: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1919: f = remove_zero_from_list(f);
1920: if ( !BDY(f) ) {
1921: *rp = f; return;
1922: }
1923: homo = QTOS((Q)ARG2(arg));
1924: m = QTOS((Q)ARG3(arg));
1.46 noro 1925: create_order_spec(0,ARG4(arg),&ord);
1926: nd_gr_trace(f,v,m,homo,ord,rp);
1.38 noro 1927: }
1.39 noro 1928:
1929: void Pnd_nf(arg,rp)
1930: NODE arg;
1931: P *rp;
1932: {
1933: P f;
1934: LIST g,v;
1.46 noro 1935: struct order_spec *ord;
1.39 noro 1936:
1937: do_weyl = 0;
1938: asir_assert(ARG0(arg),O_P,"nd_nf");
1939: asir_assert(ARG1(arg),O_LIST,"nd_nf");
1940: asir_assert(ARG2(arg),O_LIST,"nd_nf");
1941: asir_assert(ARG4(arg),O_N,"nd_nf");
1942: f = (P)ARG0(arg);
1943: g = (LIST)ARG1(arg); g = remove_zero_from_list(g);
1944: if ( !BDY(g) ) {
1945: *rp = f; return;
1946: }
1947: v = (LIST)ARG2(arg);
1.46 noro 1948: create_order_spec(0,ARG3(arg),&ord);
1949: nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),ord,rp);
1.39 noro 1950: }
1951:
1.11 noro 1952: /* for Weyl algebra */
1953:
1954: void Pdp_weyl_gr_main(arg,rp)
1955: NODE arg;
1956: LIST *rp;
1957: {
1958: LIST f,v;
1959: Num homo;
1960: Q m;
1.49 noro 1961: int modular,ac;
1.46 noro 1962: struct order_spec *ord;
1.11 noro 1963:
1.49 noro 1964:
1.11 noro 1965: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
1.49 noro 1966: f = (LIST)ARG0(arg);
1.25 noro 1967: f = remove_zero_from_list(f);
1968: if ( !BDY(f) ) {
1969: *rp = f; return;
1970: }
1.53 noro 1971: if ( (ac = argc(arg)) == 5 ) {
1.49 noro 1972: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
1973: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
1974: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
1975: v = (LIST)ARG1(arg);
1976: homo = (Num)ARG2(arg);
1977: m = (Q)ARG3(arg);
1978: if ( !m )
1979: modular = 0;
1980: else if ( PL(NM(m))>1 || (PL(NM(m)) == 1 && BD(NM(m))[0] >= 0x80000000) )
1981: error("dp_weyl_gr_main : too large modulus");
1982: else
1983: modular = QTOS(m);
1984: create_order_spec(0,ARG4(arg),&ord);
1.53 noro 1985: } else if ( current_option )
1986: parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
1.49 noro 1987: else if ( ac == 1 )
1988: parse_gr_option(f,0,&v,&homo,&modular,&ord);
1.11 noro 1989: else
1.49 noro 1990: error("dp_weyl_gr_main : invalid argument");
1.12 noro 1991: do_weyl = 1;
1.46 noro 1992: dp_gr_main(f,v,homo,modular,0,ord,rp);
1.16 noro 1993: do_weyl = 0;
1994: }
1995:
1996: void Pdp_weyl_gr_f_main(arg,rp)
1997: NODE arg;
1998: LIST *rp;
1999: {
2000: LIST f,v;
2001: Num homo;
1.46 noro 2002: struct order_spec *ord;
1.16 noro 2003:
2004: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_main");
2005: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
2006: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
2007: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
2008: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 2009: f = remove_zero_from_list(f);
2010: if ( !BDY(f) ) {
2011: *rp = f; return;
2012: }
1.16 noro 2013: homo = (Num)ARG2(arg);
1.46 noro 2014: create_order_spec(0,ARG3(arg),&ord);
1.16 noro 2015: do_weyl = 1;
1.46 noro 2016: dp_gr_main(f,v,homo,0,1,ord,rp);
1.12 noro 2017: do_weyl = 0;
1.11 noro 2018: }
2019:
2020: void Pdp_weyl_f4_main(arg,rp)
2021: NODE arg;
2022: LIST *rp;
2023: {
2024: LIST f,v;
1.46 noro 2025: struct order_spec *ord;
1.11 noro 2026:
2027: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
2028: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
2029: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 2030: f = remove_zero_from_list(f);
2031: if ( !BDY(f) ) {
2032: *rp = f; return;
2033: }
1.46 noro 2034: create_order_spec(0,ARG2(arg),&ord);
1.12 noro 2035: do_weyl = 1;
1.46 noro 2036: dp_f4_main(f,v,ord,rp);
1.12 noro 2037: do_weyl = 0;
1.11 noro 2038: }
2039:
2040: void Pdp_weyl_f4_mod_main(arg,rp)
2041: NODE arg;
2042: LIST *rp;
2043: {
2044: LIST f,v;
2045: int m;
1.46 noro 2046: struct order_spec *ord;
1.11 noro 2047:
2048: asir_assert(ARG0(arg),O_LIST,"dp_weyl_f4_main");
2049: asir_assert(ARG1(arg),O_LIST,"dp_weyl_f4_main");
2050: asir_assert(ARG2(arg),O_N,"dp_f4_main");
2051: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); m = QTOS((Q)ARG2(arg));
1.25 noro 2052: f = remove_zero_from_list(f);
2053: if ( !BDY(f) ) {
2054: *rp = f; return;
2055: }
1.20 noro 2056: if ( !m )
2057: error("dp_weyl_f4_mod_main : invalid argument");
1.46 noro 2058: create_order_spec(0,ARG3(arg),&ord);
1.12 noro 2059: do_weyl = 1;
1.46 noro 2060: dp_f4_mod_main(f,v,m,ord,rp);
1.12 noro 2061: do_weyl = 0;
1.11 noro 2062: }
2063:
2064: void Pdp_weyl_gr_mod_main(arg,rp)
2065: NODE arg;
2066: LIST *rp;
2067: {
2068: LIST f,v;
2069: Num homo;
2070: int m;
1.46 noro 2071: struct order_spec *ord;
1.11 noro 2072:
2073: asir_assert(ARG0(arg),O_LIST,"dp_weyl_gr_mod_main");
2074: asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_mod_main");
2075: asir_assert(ARG2(arg),O_N,"dp_weyl_gr_mod_main");
2076: asir_assert(ARG3(arg),O_N,"dp_weyl_gr_mod_main");
1.8 noro 2077: f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
1.25 noro 2078: f = remove_zero_from_list(f);
2079: if ( !BDY(f) ) {
2080: *rp = f; return;
2081: }
1.8 noro 2082: homo = (Num)ARG2(arg); m = QTOS((Q)ARG3(arg));
1.20 noro 2083: if ( !m )
2084: error("dp_weyl_gr_mod_main : invalid argument");
1.46 noro 2085: create_order_spec(0,ARG4(arg),&ord);
1.12 noro 2086: do_weyl = 1;
1.46 noro 2087: dp_gr_mod_main(f,v,homo,m,ord,rp);
1.12 noro 2088: do_weyl = 0;
1.1 noro 2089: }
1.8 noro 2090:
1.57 noro 2091: VECT current_dl_weight_vector_obj;
1.24 noro 2092: int *current_dl_weight_vector;
2093:
2094: void Pdp_set_weight(arg,rp)
2095: NODE arg;
2096: VECT *rp;
2097: {
2098: VECT v;
2099: int i,n;
1.45 noro 2100: NODE node;
1.24 noro 2101:
2102: if ( !arg )
2103: *rp = current_dl_weight_vector_obj;
2104: else if ( !ARG0(arg) ) {
2105: current_dl_weight_vector_obj = 0;
2106: current_dl_weight_vector = 0;
2107: *rp = 0;
2108: } else {
1.45 noro 2109: if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
2110: error("dp_set_weight : invalid argument");
2111: if ( OID(ARG0(arg)) == O_VECT )
2112: v = (VECT)ARG0(arg);
2113: else {
2114: node = (NODE)BDY((LIST)ARG0(arg));
2115: n = length(node);
2116: MKVECT(v,n);
2117: for ( i = 0; i < n; i++, node = NEXT(node) )
2118: BDY(v)[i] = BDY(node);
2119: }
1.24 noro 2120: current_dl_weight_vector_obj = v;
2121: n = v->len;
2122: current_dl_weight_vector = (int *)CALLOC(n,sizeof(int));
2123: for ( i = 0; i < n; i++ )
2124: current_dl_weight_vector[i] = QTOS((Q)v->body[i]);
2125: *rp = v;
2126: }
2127: }
2128:
2129: static VECT current_weyl_weight_vector_obj;
2130: int *current_weyl_weight_vector;
1.15 noro 2131:
2132: void Pdp_weyl_set_weight(arg,rp)
2133: NODE arg;
2134: VECT *rp;
2135: {
2136: VECT v;
2137: int i,n;
2138:
2139: if ( !arg )
1.24 noro 2140: *rp = current_weyl_weight_vector_obj;
1.15 noro 2141: else {
2142: asir_assert(ARG0(arg),O_VECT,"dp_weyl_set_weight");
2143: v = (VECT)ARG0(arg);
1.24 noro 2144: current_weyl_weight_vector_obj = v;
1.15 noro 2145: n = v->len;
1.24 noro 2146: current_weyl_weight_vector = (int *)CALLOC(n,sizeof(int));
1.15 noro 2147: for ( i = 0; i < n; i++ )
1.24 noro 2148: current_weyl_weight_vector[i] = QTOS((Q)v->body[i]);
1.15 noro 2149: *rp = v;
2150: }
1.25 noro 2151: }
2152:
2153: LIST remove_zero_from_list(LIST l)
2154: {
2155: NODE n,r0,r;
2156: LIST rl;
2157:
2158: asir_assert(l,O_LIST,"remove_zero_from_list");
2159: n = BDY(l);
2160: for ( r0 = 0; n; n = NEXT(n) )
2161: if ( BDY(n) ) {
2162: NEXTNODE(r0,r);
2163: BDY(r) = BDY(n);
2164: }
2165: if ( r0 )
2166: NEXT(r) = 0;
2167: MKLIST(rl,r0);
2168: return rl;
1.26 noro 2169: }
2170:
2171: int get_field_type(P p)
2172: {
2173: int type,t;
2174: DCP dc;
2175:
2176: if ( !p )
2177: return 0;
2178: else if ( NUM(p) )
2179: return NID((Num)p);
2180: else {
2181: type = 0;
2182: for ( dc = DC(p); dc; dc = NEXT(dc) ) {
2183: t = get_field_type(COEF(dc));
2184: if ( !t )
2185: continue;
2186: if ( t < 0 )
2187: return t;
2188: if ( !type )
2189: type = t;
2190: else if ( t != type )
2191: return -1;
2192: }
2193: return type;
1.52 noro 2194: }
2195: }
2196:
2197: void Pdpv_ord(NODE arg,Obj *rp)
2198: {
2199: int ac,id;
2200: LIST shift;
2201:
2202: ac = argc(arg);
2203: if ( ac ) {
2204: id = QTOS((Q)ARG0(arg));
2205: if ( ac > 1 && ARG1(arg) && OID((Obj)ARG1(arg))==O_LIST )
2206: shift = (LIST)ARG1(arg);
2207: else
2208: shift = 0;
2209: create_modorder_spec(id,shift,&dp_current_modspec);
2210: }
2211: *rp = dp_current_modspec->obj;
2212: }
2213:
2214: void Pdpv_ht(NODE arg,LIST *rp)
2215: {
2216: NODE n;
2217: DP ht;
2218: int pos;
2219: DPV p;
2220: Q q;
2221:
2222: asir_assert(ARG0(arg),O_DPV,"dpv_ht");
2223: p = (DPV)ARG0(arg);
2224: pos = dpv_hp(p);
2225: if ( pos < 0 )
2226: ht = 0;
2227: else
2228: dp_ht(BDY(p)[pos],&ht);
2229: STOQ(pos,q);
2230: n = mknode(2,q,ht);
2231: MKLIST(*rp,n);
2232: }
2233:
2234: void Pdpv_hm(NODE arg,LIST *rp)
2235: {
2236: NODE n;
2237: DP ht;
2238: int pos;
2239: DPV p;
2240: Q q;
2241:
2242: asir_assert(ARG0(arg),O_DPV,"dpv_hm");
2243: p = (DPV)ARG0(arg);
2244: pos = dpv_hp(p);
2245: if ( pos < 0 )
2246: ht = 0;
2247: else
2248: dp_hm(BDY(p)[pos],&ht);
2249: STOQ(pos,q);
2250: n = mknode(2,q,ht);
2251: MKLIST(*rp,n);
2252: }
2253:
2254: void Pdpv_hc(NODE arg,LIST *rp)
2255: {
2256: NODE n;
2257: P hc;
2258: int pos;
2259: DPV p;
2260: Q q;
2261:
2262: asir_assert(ARG0(arg),O_DPV,"dpv_hc");
2263: p = (DPV)ARG0(arg);
2264: pos = dpv_hp(p);
2265: if ( pos < 0 )
2266: hc = 0;
2267: else
2268: hc = BDY(BDY(p)[pos])->c;
2269: STOQ(pos,q);
2270: n = mknode(2,q,hc);
2271: MKLIST(*rp,n);
2272: }
2273:
2274: int dpv_hp(DPV p)
2275: {
2276: int len,i,maxp,maxw,w,slen;
2277: int *shift;
2278: DP *e;
2279:
2280: len = p->len;
2281: e = p->body;
2282: slen = dp_current_modspec->len;
2283: shift = dp_current_modspec->degree_shift;
2284: switch ( dp_current_modspec->id ) {
2285: case ORD_REVGRADLEX:
2286: for ( maxp = -1, i = 0; i < len; i++ )
2287: if ( !e[i] ) continue;
2288: else if ( maxp < 0 ) {
2289: maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;
2290: } else {
2291: w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);
2292: if ( w >= maxw ) {
2293: maxw = w; maxp = i;
2294: }
2295: }
2296: return maxp;
2297: case ORD_GRADLEX:
2298: for ( maxp = -1, i = 0; i < len; i++ )
2299: if ( !e[i] ) continue;
2300: else if ( maxp < 0 ) {
2301: maxw = BDY(e[i])->dl->td+(i<slen?shift[i]:0); maxp = i;
2302: } else {
2303: w = BDY(e[i])->dl->td+(i<slen?shift[i]:0);
2304: if ( w > maxw ) {
2305: maxw = w; maxp = i;
2306: }
2307: }
2308: return maxp;
2309: break;
2310: case ORD_LEX:
2311: for ( i = 0; i < len; i++ )
2312: if ( e[i] ) return i;
2313: return -1;
2314: break;
1.26 noro 2315: }
1.15 noro 2316: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to dp.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin