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