Context Navigation

source: git/Singular/ipshell.cc @ 066b2f7

spielwiese

Last change on this file since 066b2f7 was 74c52c, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: support very very long names in listvar (from master)
Property mode set to `100644`
File size: 139.5 KB

Line
1	/****************************************
2	* Computer Algebra System SINGULAR *
3	****************************************/
4	/*
5	* ABSTRACT:
6	*/
7	#include "config.h"
8	#include <kernel/mod2.h>
9	#include <misc/auxiliary.h>
10
11
12	#include <misc/options.h>
13	#include <misc/mylimits.h>
14
15	#ifdef HAVE_FACTORY
16	#define SI_DONT_HAVE_GLOBAL_VARS
17	#include <factory/factory.h>
18	#endif
19
20	#include <Singular/maps_ip.h>
21	#include <Singular/tok.h>
22	#include <misc/options.h>
23	#include <Singular/ipid.h>
24	#include <misc/intvec.h>
25	#include <omalloc/omalloc.h>
26	#include <kernel/febase.h>
27	#include <kernel/polys.h>
28	#include <coeffs/numbers.h>
29	#include <polys/prCopy.h>
30	#include <kernel/ideals.h>
31	#include <polys/matpol.h>
32	#include <kernel/kstd1.h>
33	#include <polys/monomials/ring.h>
34	#include <Singular/subexpr.h>
35	#include <polys/monomials/maps.h>
36	#include <kernel/syz.h>
37	#include <coeffs/numbers.h>
38	#include <kernel/modulop.h>
39	//#include <polys/ext_fields/longalg.h>
40	#include <Singular/lists.h>
41	#include <Singular/attrib.h>
42	#include <Singular/ipconv.h>
43	#include <Singular/silink.h>
44	#include <kernel/stairc.h>
45	#include <polys/weight.h>
46	#include <kernel/semic.h>
47	#include <kernel/splist.h>
48	#include <kernel/spectrum.h>
49	////// #include <coeffs/gnumpfl.h>
50	//#include <kernel/mpr_base.h>
51	////// #include <coeffs/ffields.h>
52	#include <polys/clapsing.h>
53	#include <kernel/hutil.h>
54	#include <polys/monomials/ring.h>
55	#include <Singular/ipshell.h>
56	#include <polys/ext_fields/algext.h>
57	#include <coeffs/mpr_complex.h>
58	#include <coeffs/longrat.h>
59	#include <coeffs/rmodulon.h>
60
61	#include <numeric/mpr_base.h>
62	#include <numeric/mpr_numeric.h>
63
64	#include <math.h>
65	#include <ctype.h>
66
67	#include <polys/ext_fields/algext.h>
68	#include <polys/ext_fields/transext.h>
69
70	// define this if you want to use the fast_map routine for mapping ideals
71	#define FAST_MAP
72
73	#ifdef FAST_MAP
74	#include <kernel/fast_maps.h>
75	#endif
76
77	leftv iiCurrArgs=NULL;
78	idhdl iiCurrProc=NULL;
79	const char *lastreserved=NULL;
80
81	static BOOLEAN iiNoKeepRing=TRUE;
82
83	/0 implementation/
84
85	const char * iiTwoOps(int t)
86	{
87	if (t<127)
88	{
89	static char ch[2];
90	switch (t)
91	{
92	case '&':
93	return "and";
94	case '\|':
95	return "or";
96	default:
97	ch[0]=t;
98	ch[1]='\0';
99	return ch;
100	}
101	}
102	switch (t)
103	{
104	case COLONCOLON: return "::";
105	case DOTDOT: return "..";
106	//case PLUSEQUAL: return "+=";
107	//case MINUSEQUAL: return "-=";
108	case MINUSMINUS: return "--";
109	case PLUSPLUS: return "++";
110	case EQUAL_EQUAL: return "==";
111	case LE: return "<=";
112	case GE: return ">=";
113	case NOTEQUAL: return "<>";
114	default: return Tok2Cmdname(t);
115	}
116	}
117
118	int iiOpsTwoChar(const char *s)
119	{
120	/* not handling: &&, \|\|, ** */
121	if (s[1]=='\0') return s[0];
122	else if (s[2]!='\0') return 0;
123	switch(s[0])
124	{
125	case '.': if (s[1]=='.') return DOTDOT;
126	else return 0;
127	case ':': if (s[1]==':') return COLONCOLON;
128	else return 0;
129	case '-': if (s[1]=='-') return COLONCOLON;
130	else return 0;
131	case '+': if (s[1]=='+') return PLUSPLUS;
132	else return 0;
133	case '=': if (s[1]=='=') return EQUAL_EQUAL;
134	else return 0;
135	case '<': if (s[1]=='=') return LE;
136	else if (s[1]=='>') return NOTEQUAL;
137	else return 0;
138	case '>': if (s[1]=='=') return GE;
139	else return 0;
140	case '!': if (s[1]=='=') return NOTEQUAL;
141	else return 0;
142	}
143	return 0;
144	}
145
146	static void list1(const char* s, idhdl h,BOOLEAN c, BOOLEAN fullname)
147	{
148	char buffer[22];
149	int l;
150	char buf2[128];
151
152	if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
153	else sprintf(buf2, "%s", IDID(h));
154
155	Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
156	if (h == currRingHdl) PrintS("*");
157	PrintS(Tok2Cmdname((int)IDTYP(h)));
158
159	ipListFlag(h);
160	switch(IDTYP(h))
161	{
162	case INT_CMD: Print(" %d",IDINT(h)); break;
163	case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
164	case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
165	break;
166	case POLY_CMD:
167	case VECTOR_CMD:if (c)
168	{
169	PrintS(" ");wrp(IDPOLY(h));
170	if(IDPOLY(h) != NULL)
171	{
172	Print(", %d monomial(s)",pLength(IDPOLY(h)));
173	}
174	}
175	break;
176	case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));
177	case IDEAL_CMD: Print(", %u generator(s)",
178	IDELEMS(IDIDEAL(h))); break;
179	case MAP_CMD:
180	Print(" from %s",IDMAP(h)->preimage); break;
181	case MATRIX_CMD:Print(" %u x %u"
182	,MATROWS(IDMATRIX(h))
183	,MATCOLS(IDMATRIX(h))
184	);
185	break;
186	case PACKAGE_CMD:
187	PrintS(" (");
188	switch (IDPACKAGE(h)->language)
189	{
190	case LANG_SINGULAR: PrintS("S"); break;
191	case LANG_C: PrintS("C"); break;
192	case LANG_TOP: PrintS("T"); break;
193	case LANG_NONE: PrintS("N"); break;
194	default: PrintS("U");
195	}
196	if(IDPACKAGE(h)->libname!=NULL)
197	Print(",%s", IDPACKAGE(h)->libname);
198	PrintS(")");
199	break;
200	case PROC_CMD: if((IDPROC(h)->libname!=NULL)
201	&& (strlen(IDPROC(h)->libname)>0))
202	Print(" from %s",IDPROC(h)->libname);
203	if(IDPROC(h)->is_static)
204	PrintS(" (static)");
205	break;
206	case STRING_CMD:
207	{
208	char *s;
209	l=strlen(IDSTRING(h));
210	memset(buffer,0,22);
211	strncpy(buffer,IDSTRING(h),si_min(l,20));
212	if ((s=strchr(buffer,'\n'))!=NULL)
213	{
214	*s='\0';
215	}
216	PrintS(" ");
217	PrintS(buffer);
218	if((s!=NULL) \|\|(l>20))
219	{
220	Print("..., %d char(s)",l);
221	}
222	break;
223	}
224	case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
225	break;
226	case QRING_CMD:
227	case RING_CMD:
228	if ((IDRING(h)==currRing) && (currRingHdl!=h))
229	PrintS("()"); / this is an alias to currRing */
230	#ifdef RDEBUG
231	if (traceit &TRACE_SHOW_RINGS)
232	Print(" <%lx>",(long)(IDRING(h)));
233	#endif
234	break;
235	/default: break;/
236	}
237	PrintLn();
238	}
239
240	void type_cmd(leftv v)
241	{
242	BOOLEAN oldShortOut = FALSE;
243
244	if (currRing != NULL)
245	{
246	oldShortOut = currRing->ShortOut;
247	currRing->ShortOut = 1;
248	}
249	int t=v->Typ();
250	Print("// %s %s ",v->Name(),Tok2Cmdname(t));
251	switch (t)
252	{
253	case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
254	case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
255	((intvec*)(v->Data()))->cols()); break;
256	case MATRIX_CMD:Print(" %u x %u\n" ,
257	MATROWS((matrix)(v->Data())),
258	MATCOLS((matrix)(v->Data())));break;
259	case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
260	case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
261
262	case PROC_CMD:
263	case RING_CMD:
264	case IDEAL_CMD:
265	case QRING_CMD: PrintLn(); break;
266
267	//case INT_CMD:
268	//case STRING_CMD:
269	//case INTVEC_CMD:
270	//case POLY_CMD:
271	//case VECTOR_CMD:
272	//case PACKAGE_CMD:
273
274	default:
275	break;
276	}
277	v->Print();
278	if (currRing != NULL)
279	currRing->ShortOut = oldShortOut;
280	}
281
282	static void killlocals0(int v, idhdl * localhdl, const ring r)
283	{
284	idhdl h = *localhdl;
285	while (h!=NULL)
286	{
287	int vv;
288	//Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
289	if ((vv=IDLEV(h))>0)
290	{
291	if (vv < v)
292	{
293	if (iiNoKeepRing)
294	{
295	//PrintS(" break\n");
296	return;
297	}
298	h = IDNEXT(h);
299	//PrintLn();
300	}
301	else //if (vv >= v)
302	{
303	idhdl nexth = IDNEXT(h);
304	killhdl2(h,localhdl,r);
305	h = nexth;
306	//PrintS("kill\n");
307	}
308	}
309	else
310	{
311	h = IDNEXT(h);
312	//PrintLn();
313	}
314	}
315	}
316	void killlocals_list(lists l,int v)
317	{
318	int i;
319	for(i=l->nr; i>=0; i--)
320	{
321	if (l->m[i].rtyp == LIST_CMD)
322	killlocals_list((lists)l->m[i].data,v);
323	else if ((l->m[i].rtyp == RING_CMD) \|\| (l->m[i].rtyp == QRING_CMD))
324	killlocals0(v,&(((ring)(l->m[i].data))->idroot),currRing);
325	}
326	}
327	void killlocals_rec(idhdl *root,int v, ring r)
328	{
329	idhdl h=*root;
330	while (h!=NULL)
331	{
332	if (IDLEV(h)>=v)
333	{
334	// Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
335	idhdl n=IDNEXT(h);
336	killhdl2(h,root,r);
337	h=n;
338	}
339	else if (IDTYP(h)==PACKAGE_CMD)
340	{
341	// Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
342	if (IDPACKAGE(h)!=basePack)
343	killlocals_rec(&(IDRING(h)->idroot),v,r);
344	h=IDNEXT(h);
345	}
346	else if ((IDTYP(h)==RING_CMD)
347	\|\|(IDTYP(h)==QRING_CMD))
348	{
349	if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
350	// we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
351	{
352	// Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
353	killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
354	}
355	h=IDNEXT(h);
356	}
357	else
358	{
359	// Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
360	h=IDNEXT(h);
361	}
362	}
363	}
364	BOOLEAN killlocals_list(int v, lists L)
365	{
366	if (L==NULL) return FALSE;
367	BOOLEAN changed=FALSE;
368	int n=L->nr;
369	for(;n>=0;n--)
370	{
371	leftv h=&(L->m[n]);
372	void *d=h->data;
373	if (((h->rtyp==RING_CMD) \|\| (h->rtyp==QRING_CMD))
374	&& (((ring)d)->idroot!=NULL))
375	{
376	if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
377	killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
378	}
379	else if (h->rtyp==LIST_CMD)
380	changed\|=killlocals_list(v,(lists)d);
381	}
382	return changed;
383	}
384	void killlocals(int v)
385	{
386	BOOLEAN changed=FALSE;
387	idhdl sh=currRingHdl;
388	ring cr=currRing;
389	if (sh!=NULL) changed=((IDLEV(sh)<v) \|\| (IDRING(sh)->ref>0));
390	//if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
391
392	killlocals_rec(&(basePack->idroot),v,currRing);
393
394	if (iiRETURNEXPR_len > myynest)
395	{
396	int t=iiRETURNEXPR.Typ();
397	if ((/iiRETURNEXPR.Typ()/ t==RING_CMD)
398	\|\| (/iiRETURNEXPR.Typ()/ t==QRING_CMD))
399	{
400	leftv h=&iiRETURNEXPR;
401	if (((ring)h->data)->idroot!=NULL)
402	killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
403	}
404	else if (/iiRETURNEXPR.Typ()/ t==LIST_CMD)
405	{
406	leftv h=&iiRETURNEXPR;
407	changed \|=killlocals_list(v,(lists)h->data);
408	}
409	}
410	if (changed)
411	{
412	currRingHdl=rFindHdl(cr,NULL,NULL);
413	if (currRingHdl==NULL)
414	currRing=NULL;
415	else
416	rChangeCurrRing(cr);
417	}
418
419	if (myynest<=1) iiNoKeepRing=TRUE;
420	//Print("end killlocals >= %d\n",v);
421	//listall();
422	}
423
424	void list_cmd(int typ, const char* what, const char *prefix,BOOLEAN iterate, BOOLEAN fullname)
425	{
426	idhdl h,start;
427	BOOLEAN all = typ<0;
428	BOOLEAN really_all=FALSE;
429
430	if ( typ==0 )
431	{
432	if (strcmp(what,"all")==0)
433	{
434	really_all=TRUE;
435	h=basePack->idroot;
436	}
437	else
438	{
439	h = ggetid(what);
440	if (h!=NULL)
441	{
442	if (iterate) list1(prefix,h,TRUE,fullname);
443	if (IDTYP(h)==ALIAS_CMD) PrintS("A");
444	if ((IDTYP(h)==RING_CMD)
445	\|\| (IDTYP(h)==QRING_CMD)
446	//\|\| (IDTYP(h)==PACKE_CMD)
447	)
448	{
449	h=IDRING(h)->idroot;
450	}
451	else if((IDTYP(h)==PACKAGE_CMD) \|\| (IDTYP(h)==POINTER_CMD))
452	{
453	//Print("list_cmd:package or pointer\n");
454	all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
455	h=IDPACKAGE(h)->idroot;
456	}
457	else
458	return;
459	}
460	else
461	{
462	Werror("%s is undefined",what);
463	return;
464	}
465	}
466	all=TRUE;
467	}
468	else if (RingDependend(typ))
469	{
470	h = currRing->idroot;
471	}
472	else
473	h = IDROOT;
474	start=h;
475	while (h!=NULL)
476	{
477	if ((all && (IDTYP(h)!=PROC_CMD) &&(IDTYP(h)!=PACKAGE_CMD))
478	\|\| (typ == IDTYP(h))
479	\|\| ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD)))
480	{
481	list1(prefix,h,start==currRingHdl, fullname);
482	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
483	&& (really_all \|\| (all && (h==currRingHdl)))
484	&& ((IDLEV(h)==0)\|\|(IDLEV(h)==myynest)))
485	{
486	list_cmd(0,IDID(h),"// ",FALSE);
487	}
488	if (IDTYP(h)==PACKAGE_CMD && really_all)
489	{
490	package save_p=currPack;
491	currPack=IDPACKAGE(h);
492	list_cmd(0,IDID(h),"// ",FALSE);
493	currPack=save_p;
494	}
495	}
496	h = IDNEXT(h);
497	}
498	}
499
500	void test_cmd(int i)
501	{
502	int ii;
503
504	if (i<0)
505	{
506	ii= -i;
507	if (ii < 32)
508	{
509	si_opt_1 &= ~Sy_bit(ii);
510	}
511	else if (ii < 64)
512	{
513	si_opt_2 &= ~Sy_bit(ii-32);
514	}
515	else
516	WerrorS("out of bounds\n");
517	}
518	else if (i<32)
519	{
520	ii=i;
521	if (Sy_bit(ii) & kOptions)
522	{
523	Warn("Gerhard, use the option command");
524	si_opt_1 \|= Sy_bit(ii);
525	}
526	else if (Sy_bit(ii) & validOpts)
527	si_opt_1 \|= Sy_bit(ii);
528	}
529	else if (i<64)
530	{
531	ii=i-32;
532	si_opt_2 \|= Sy_bit(ii);
533	}
534	else
535	WerrorS("out of bounds\n");
536	}
537
538	int exprlist_length(leftv v)
539	{
540	int rc = 0;
541	while (v!=NULL)
542	{
543	switch (v->Typ())
544	{
545	case INT_CMD:
546	case POLY_CMD:
547	case VECTOR_CMD:
548	case NUMBER_CMD:
549	rc++;
550	break;
551	case INTVEC_CMD:
552	case INTMAT_CMD:
553	rc += ((intvec *)(v->Data()))->length();
554	break;
555	case MATRIX_CMD:
556	case IDEAL_CMD:
557	case MODUL_CMD:
558	{
559	matrix mm = (matrix)(v->Data());
560	rc += mm->rows() * mm->cols();
561	}
562	break;
563	case LIST_CMD:
564	rc+=((lists)v->Data())->nr+1;
565	break;
566	default:
567	rc++;
568	}
569	v = v->next;
570	}
571	return rc;
572	}
573
574	int iiIsPrime0(unsigned p) /* brute force !!!! */
575	{
576	unsigned i,j=0 /only to avoid compiler warnings/;
577	#ifdef HAVE_FACTORY
578	if (p<=32749) // max. small prime in factory
579	{
580	int a=0;
581	int e=cf_getNumSmallPrimes()-1;
582	i=e/2;
583	do
584	{
585	j=cf_getSmallPrime(i);
586	if (p==j) return p;
587	if (p<j) e=i-1;
588	else a=i+1;
589	i=a+(e-a)/2;
590	} while ( a<= e);
591	if (p>j) return j;
592	else return cf_getSmallPrime(i-1);
593	}
594	#endif
595	#ifdef HAVE_FACTORY
596	unsigned end_i=cf_getNumSmallPrimes()-1;
597	#else
598	unsigned end_i=p/2;
599	#endif
600	unsigned end_p=(unsigned)sqrt((double)p);
601	restart:
602	for (i=0; i<end_i; i++)
603	{
604	#ifdef HAVE_FACTORY
605	j=cf_getSmallPrime(i);
606	#else
607	if (i==0) j=2;
608	else j=2*i-1;
609	#endif
610	if ((p%j) == 0)
611	{
612	#ifdef HAVE_FACTORY
613	if (p<=32751) return iiIsPrime0(p-2);
614	#endif
615	p-=2;
616	goto restart;
617	}
618	if (j > end_p) return p;
619	}
620	#ifdef HAVE_FACTORY
621	if (i>=end_i)
622	{
623	while(j<=end_p)
624	{
625	j+=2;
626	if ((p%j) == 0)
627	{
628	if (p<=32751) return iiIsPrime0(p-2);
629	p-=2;
630	goto restart;
631	}
632	}
633	}
634	#endif
635	return p;
636	}
637	int IsPrime(int p) /* brute force !!!! */
638	{
639	if (p == 0) return 0;
640	else if (p == 1) return 1/1/;
641	else if ((p == 2)\|\|(p==3)) return p;
642	else if (p < 0) return 2; //(iiIsPrime0((unsigned)(-p)));
643	else if ((p & 1)==0) return iiIsPrime0((unsigned)(p-1));
644	return iiIsPrime0((unsigned)(p));
645	}
646
647	BOOLEAN iiWRITE(leftv,leftv v)
648	{
649	sleftv vf;
650	if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
651	{
652	WerrorS("link expected");
653	return TRUE;
654	}
655	si_link l=(si_link)vf.Data();
656	if (vf.next == NULL)
657	{
658	WerrorS("write: need at least two arguments");
659	return TRUE;
660	}
661
662	BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
663	if (b)
664	{
665	const char *s;
666	if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
667	else s=sNoName;
668	Werror("cannot write to %s",s);
669	}
670	vf.CleanUp();
671	return b;
672	}
673
674	leftv iiMap(map theMap, const char * what)
675	{
676	idhdl w,r;
677	leftv v;
678	int i;
679	nMapFunc nMap;
680
681	r=IDROOT->get(theMap->preimage,myynest);
682	if ((currPack!=basePack)
683	&&((r==NULL) \|\| ((r->typ != RING_CMD) && (r->typ != QRING_CMD))))
684	r=basePack->idroot->get(theMap->preimage,myynest);
685	if ((r==NULL) && (currRingHdl!=NULL)
686	&& (strcmp(theMap->preimage,IDID(currRingHdl))==0))
687	{
688	r=currRingHdl;
689	}
690	if ((r!=NULL) && ((r->typ == RING_CMD) \|\| (r->typ== QRING_CMD)))
691	{
692	//if ((nMap=nSetMap(rInternalChar(IDRING(r)),
693	// IDRING(r)->parameter,
694	// rPar(IDRING(r)),
695	// IDRING(r)->minpoly)))
696	if ((nMap=n_SetMap(IDRING(r)->cf, currRing->cf))==NULL)
697	{
698	////////// WTF?
699	// if (rEqual(IDRING(r),currRing))
700	// {
701	// nMap = n_SetMap(currRing->cf, currRing->cf);
702	// }
703	// else
704	// {
705	Werror("can not map from ground field of %s to current ground field",
706	theMap->preimage);
707	return NULL;
708	// }
709	}
710	if (IDELEMS(theMap)<IDRING(r)->N)
711	{
712	theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
713	IDELEMS(theMap)*sizeof(poly),
714	(IDRING(r)->N)*sizeof(poly));
715	for(i=IDELEMS(theMap);i<IDRING(r)->N;i++)
716	theMap->m[i]=NULL;
717	IDELEMS(theMap)=IDRING(r)->N;
718	}
719	if (what==NULL)
720	{
721	WerrorS("argument of a map must have a name");
722	}
723	else if ((w=IDRING(r)->idroot->get(what,myynest))!=NULL)
724	{
725	char *save_r=NULL;
726	v=(leftv)omAlloc0Bin(sleftv_bin);
727	sleftv tmpW;
728	memset(&tmpW,0,sizeof(sleftv));
729	tmpW.rtyp=IDTYP(w);
730	if (tmpW.rtyp==MAP_CMD)
731	{
732	tmpW.rtyp=IDEAL_CMD;
733	save_r=IDMAP(w)->preimage;
734	IDMAP(w)->preimage=0;
735	}
736	tmpW.data=IDDATA(w);
737	#if 0
738	if (((tmpW.rtyp==IDEAL_CMD)\|\|(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
739	{
740	v->rtyp=tmpW.rtyp;
741	v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
742	}
743	else
744	#endif
745	{
746	#ifdef FAST_MAP
747	if ((tmpW.rtyp==IDEAL_CMD) && (nMap == ndCopyMap)
748	#ifdef HAVE_PLURAL
749	&& (!rIsPluralRing(currRing))
750	#endif
751	)
752	{
753	v->rtyp=IDEAL_CMD;
754	v->data=fast_map(IDIDEAL(w), IDRING(r), (ideal)theMap, currRing);
755	}
756	else
757	#endif
758	if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,IDRING(r),NULL,NULL,0,nMap))
759	{
760	Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
761	omFreeBin((ADDRESS)v, sleftv_bin);
762	if (save_r!=NULL) IDMAP(w)->preimage=save_r;
763	return NULL;
764	}
765	}
766	if (save_r!=NULL)
767	{
768	IDMAP(w)->preimage=save_r;
769	IDMAP((idhdl)v)->preimage=omStrDup(save_r);
770	v->rtyp=MAP_CMD;
771	}
772	return v;
773	}
774	else
775	{
776	Werror("%s undefined in %s",what,theMap->preimage);
777	}
778	}
779	else
780	{
781	Werror("cannot find preimage %s",theMap->preimage);
782	}
783	return NULL;
784	}
785
786	#ifdef OLD_RES
787	void iiMakeResolv(resolvente r, int length, int rlen, char * name, int typ0,
788	intvec ** weights)
789	{
790	lists L=liMakeResolv(r,length,rlen,typ0,weights);
791	int i=0;
792	idhdl h;
793	char * s=(char *)omAlloc(strlen(name)+5);
794
795	while (i<=L->nr)
796	{
797	sprintf(s,"%s(%d)",name,i+1);
798	if (i==0)
799	h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
800	else
801	h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
802	if (h!=NULL)
803	{
804	h->data.uideal=(ideal)L->m[i].data;
805	h->attribute=L->m[i].attribute;
806	if (BVERBOSE(V_DEF_RES))
807	Print("//defining: %s as %d-th syzygy module\n",s,i+1);
808	}
809	else
810	{
811	idDelete((ideal *)&(L->m[i].data));
812	Warn("cannot define %s",s);
813	}
814	//L->m[i].data=NULL;
815	//L->m[i].rtyp=0;
816	//L->m[i].attribute=NULL;
817	i++;
818	}
819	omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
820	omFreeBin((ADDRESS)L, slists_bin);
821	omFreeSize((ADDRESS)s,strlen(name)+5);
822	}
823	#endif
824
825	//resolvente iiFindRes(char * name, int * len, int *typ0)
826	//{
827	// char s=(char )omAlloc(strlen(name)+5);
828	// int i=-1;
829	// resolvente r;
830	// idhdl h;
831	//
832	// do
833	// {
834	// i++;
835	// sprintf(s,"%s(%d)",name,i+1);
836	// h=currRing->idroot->get(s,myynest);
837	// } while (h!=NULL);
838	// *len=i-1;
839	// if (*len<=0)
840	// {
841	// Werror("no objects %s(1),.. found",name);
842	// omFreeSize((ADDRESS)s,strlen(name)+5);
843	// return NULL;
844	// }
845	// r=(ideal )omAlloc(/(len+1)/ isizeof(ideal));
846	// memset(r,0,(len)sizeof(ideal));
847	// i=-1;
848	// *typ0=MODUL_CMD;
849	// while (i<(*len))
850	// {
851	// i++;
852	// sprintf(s,"%s(%d)",name,i+1);
853	// h=currRing->idroot->get(s,myynest);
854	// if (h->typ != MODUL_CMD)
855	// {
856	// if ((i!=0) \|\| (h->typ!=IDEAL_CMD))
857	// {
858	// Werror("%s is not of type module",s);
859	// omFreeSize((ADDRESS)r,(len)sizeof(ideal));
860	// omFreeSize((ADDRESS)s,strlen(name)+5);
861	// return NULL;
862	// }
863	// *typ0=IDEAL_CMD;
864	// }
865	// if ((i>0) && (idIs0(r[i-1])))
866	// {
867	// *len=i-1;
868	// break;
869	// }
870	// r[i]=IDIDEAL(h);
871	// }
872	// omFreeSize((ADDRESS)s,strlen(name)+5);
873	// return r;
874	//}
875
876	static resolvente iiCopyRes(resolvente r, int l)
877	{
878	int i;
879	resolvente res=(ideal )omAlloc0((l+1)sizeof(ideal));
880
881	for (i=0; i<l; i++)
882	res[i]=idCopy(r[i]);
883	return res;
884	}
885
886	BOOLEAN jjMINRES(leftv res, leftv v)
887	{
888	int len=0;
889	int typ0;
890	lists L=(lists)v->Data();
891	intvec weights=(intvec)atGet(v,"isHomog",INTVEC_CMD);
892	int add_row_shift = 0;
893	if (weights==NULL)
894	weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
895	if (weights!=NULL) add_row_shift=weights->min_in();
896	resolvente rr=liFindRes(L,&len,&typ0);
897	if (rr==NULL) return TRUE;
898	resolvente r=iiCopyRes(rr,len);
899
900	syMinimizeResolvente(r,len,0);
901	omFreeSize((ADDRESS)rr,len*sizeof(ideal));
902	len++;
903	res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
904	return FALSE;
905	}
906
907	BOOLEAN jjBETTI(leftv res, leftv u)
908	{
909	sleftv tmp;
910	memset(&tmp,0,sizeof(tmp));
911	tmp.rtyp=INT_CMD;
912	tmp.data=(void *)1;
913	if ((u->Typ()==IDEAL_CMD)
914	\|\| (u->Typ()==MODUL_CMD))
915	return jjBETTI2_ID(res,u,&tmp);
916	else
917	return jjBETTI2(res,u,&tmp);
918	}
919
920	BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
921	{
922	lists l=(lists) omAllocBin(slists_bin);
923	l->Init(1);
924	l->m[0].rtyp=u->Typ();
925	l->m[0].data=u->Data();
926	attr *a=u->Attribute();
927	if (a!=NULL)
928	l->m[0].attribute=*a;
929	sleftv tmp2;
930	memset(&tmp2,0,sizeof(tmp2));
931	tmp2.rtyp=LIST_CMD;
932	tmp2.data=(void *)l;
933	BOOLEAN r=jjBETTI2(res,&tmp2,v);
934	l->m[0].data=NULL;
935	l->m[0].attribute=NULL;
936	l->m[0].rtyp=DEF_CMD;
937	l->Clean();
938	return r;
939	}
940
941	BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
942	{
943	resolvente r;
944	int len;
945	int reg,typ0;
946	lists l=(lists)u->Data();
947
948	intvec *weights=NULL;
949	int add_row_shift=0;
950	intvec ww=(intvec )atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
951	if (ww!=NULL)
952	{
953	weights=ivCopy(ww);
954	add_row_shift = ww->min_in();
955	(*weights) -= add_row_shift;
956	}
957	//Print("attr:%x\n",weights);
958
959	r=liFindRes(l,&len,&typ0);
960	if (r==NULL) return TRUE;
961	res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
962	omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
963	atSet(res,omStrDup("rowShift"),(void*)add_row_shift,INT_CMD);
964	if (weights!=NULL) delete weights;
965	return FALSE;
966	}
967
968	int iiRegularity(lists L)
969	{
970	int len,reg,typ0;
971
972	resolvente r=liFindRes(L,&len,&typ0);
973
974	if (r==NULL)
975	return -2;
976	intvec *weights=NULL;
977	int add_row_shift=0;
978	intvec ww=(intvec )atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
979	if (ww!=NULL)
980	{
981	weights=ivCopy(ww);
982	add_row_shift = ww->min_in();
983	(*weights) -= add_row_shift;
984	}
985	//Print("attr:%x\n",weights);
986
987	intvec *dummy=syBetti(r,len,&reg,weights);
988	if (weights!=NULL) delete weights;
989	delete dummy;
990	omFreeSize((ADDRESS)r,len*sizeof(ideal));
991	return reg+1+add_row_shift;
992	}
993
994	BOOLEAN iiDebugMarker=TRUE;
995	#define BREAK_LINE_LENGTH 80
996	void iiDebug()
997	{
998	Print("\n-- break point in %s --\n",VoiceName());
999	if (iiDebugMarker) VoiceBackTrack();
1000	char * s;
1001	iiDebugMarker=FALSE;
1002	s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1003	loop
1004	{
1005	memset(s,0,80);
1006	fe_fgets_stdin("",s,BREAK_LINE_LENGTH);
1007	if (s[BREAK_LINE_LENGTH-1]!='\0')
1008	{
1009	Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1010	}
1011	else
1012	break;
1013	}
1014	if (*s=='\n')
1015	{
1016	iiDebugMarker=TRUE;
1017	}
1018	#if MDEBUG
1019	else if(strncmp(s,"cont;",5)==0)
1020	{
1021	iiDebugMarker=TRUE;
1022	}
1023	#endif /* MDEBUG */
1024	else
1025	{
1026	strcat( s, "\n;~\n");
1027	newBuffer(s,BT_execute);
1028	}
1029	}
1030
1031	lists scIndIndset(ideal S, BOOLEAN all, ideal Q)
1032	{
1033	int i;
1034	indset save;
1035	lists res=(lists)omAlloc0Bin(slists_bin);
1036
1037	hexist = hInit(S, Q, &hNexist);
1038	if (hNexist == 0)
1039	{
1040	intvec *iv=new intvec(rVar(currRing));
1041	for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1042	res->Init(1);
1043	res->m[0].rtyp=INTVEC_CMD;
1044	res->m[0].data=(intvec*)iv;
1045	return res;
1046	}
1047	else if (hisModule!=0)
1048	{
1049	res->Init(0);
1050	return res;
1051	}
1052	save = ISet = (indset)omAlloc0Bin(indlist_bin);
1053	hMu = 0;
1054	hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1055	hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1056	hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1057	hrad = hexist;
1058	hNrad = hNexist;
1059	radmem = hCreate(rVar(currRing) - 1);
1060	hCo = rVar(currRing) + 1;
1061	hNvar = rVar(currRing);
1062	hRadical(hrad, &hNrad, hNvar);
1063	hSupp(hrad, hNrad, hvar, &hNvar);
1064	if (hNvar)
1065	{
1066	hCo = hNvar;
1067	memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1068	hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1069	hLexR(hrad, hNrad, hvar, hNvar);
1070	hDimSolve(hpure, hNpure, hrad, hNrad, hvar, hNvar);
1071	}
1072	if (hCo && (hCo < rVar(currRing)))
1073	{
1074	hIndMult(hpure, hNpure, hrad, hNrad, hvar, hNvar);
1075	}
1076	if (hMu!=0)
1077	{
1078	ISet = save;
1079	hMu2 = 0;
1080	if (all && (hCo+1 < rVar(currRing)))
1081	{
1082	JSet = (indset)omAlloc0Bin(indlist_bin);
1083	hIndAllMult(hpure, hNpure, hrad, hNrad, hvar, hNvar);
1084	i=hMu+hMu2;
1085	res->Init(i);
1086	if (hMu2 == 0)
1087	{
1088	omFreeBin((ADDRESS)JSet, indlist_bin);
1089	}
1090	}
1091	else
1092	{
1093	res->Init(hMu);
1094	}
1095	for (i=0;i<hMu;i++)
1096	{
1097	res->m[i].data = (void *)save->set;
1098	res->m[i].rtyp = INTVEC_CMD;
1099	ISet = save;
1100	save = save->nx;
1101	omFreeBin((ADDRESS)ISet, indlist_bin);
1102	}
1103	omFreeBin((ADDRESS)save, indlist_bin);
1104	if (hMu2 != 0)
1105	{
1106	save = JSet;
1107	for (i=hMu;i<hMu+hMu2;i++)
1108	{
1109	res->m[i].data = (void *)save->set;
1110	res->m[i].rtyp = INTVEC_CMD;
1111	JSet = save;
1112	save = save->nx;
1113	omFreeBin((ADDRESS)JSet, indlist_bin);
1114	}
1115	omFreeBin((ADDRESS)save, indlist_bin);
1116	}
1117	}
1118	else
1119	{
1120	res->Init(0);
1121	omFreeBin((ADDRESS)ISet, indlist_bin);
1122	}
1123	hKill(radmem, rVar(currRing) - 1);
1124	omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1125	omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1126	omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1127	hDelete(hexist, hNexist);
1128	return res;
1129	}
1130
1131	int iiDeclCommand(leftv sy, leftv name, int lev,int t, idhdl* root,BOOLEAN isring, BOOLEAN init_b)
1132	{
1133	BOOLEAN res=FALSE;
1134	const char *id = name->name;
1135
1136	memset(sy,0,sizeof(sleftv));
1137	if ((name->name==NULL)\|\|(isdigit(name->name[0])))
1138	{
1139	WerrorS("object to declare is not a name");
1140	res=TRUE;
1141	}
1142	else
1143	{
1144	//if (name->rtyp!=0)
1145	//{
1146	// Warn("`%s` is already in use",name->name);
1147	//}
1148	{
1149	sy->data = (char *)enterid(id,lev,t,root,init_b);
1150	}
1151	if (sy->data!=NULL)
1152	{
1153	sy->rtyp=IDHDL;
1154	currid=sy->name=IDID((idhdl)sy->data);
1155	// name->name=NULL; /* used in enterid */
1156	//sy->e = NULL;
1157	if (name->next!=NULL)
1158	{
1159	sy->next=(leftv)omAllocBin(sleftv_bin);
1160	res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1161	}
1162	}
1163	else res=TRUE;
1164	}
1165	name->CleanUp();
1166	return res;
1167	}
1168
1169	BOOLEAN iiDefaultParameter(leftv p)
1170	{
1171	attr at=NULL;
1172	if (iiCurrProc!=NULL)
1173	at=iiCurrProc->attribute->get("default_arg");
1174	if (at==NULL)
1175	return FALSE;
1176	sleftv tmp;
1177	memset(&tmp,0,sizeof(sleftv));
1178	tmp.rtyp=at->atyp;
1179	tmp.data=at->CopyA();
1180	return iiAssign(p,&tmp);
1181	}
1182	BOOLEAN iiParameter(leftv p)
1183	{
1184	if (iiCurrArgs==NULL)
1185	{
1186	if (strcmp(p->name,"#")==0)
1187	return iiDefaultParameter(p);
1188	Werror("not enough arguments for proc %s",VoiceName());
1189	p->CleanUp();
1190	return TRUE;
1191	}
1192	leftv h=iiCurrArgs;
1193	if (strcmp(p->name,"#")==0)
1194	{
1195	iiCurrArgs=NULL;
1196	}
1197	else
1198	{
1199	iiCurrArgs=h->next;
1200	h->next=NULL;
1201	}
1202	BOOLEAN res=iiAssign(p,h);
1203	h->CleanUp();
1204	omFreeBin((ADDRESS)h, sleftv_bin);
1205	return res;
1206	}
1207	BOOLEAN iiAlias(leftv p)
1208	{
1209	if (iiCurrArgs==NULL)
1210	{
1211	Werror("not enough arguments for proc %s",VoiceName());
1212	p->CleanUp();
1213	return TRUE;
1214	}
1215	leftv h=iiCurrArgs;
1216	iiCurrArgs=h->next;
1217	h->next=NULL;
1218	if (h->rtyp!=IDHDL)
1219	{
1220	WerrorS("identifier required");
1221	return TRUE;
1222	}
1223	if (h->Typ()!=p->Typ())
1224	{
1225	WerrorS("type mismatch");
1226	return TRUE;
1227	}
1228	idhdl pp=(idhdl)p->data;
1229	switch(pp->typ)
1230	{
1231	case INT_CMD:
1232	break;
1233	case INTVEC_CMD:
1234	case INTMAT_CMD:
1235	delete IDINTVEC(pp);
1236	break;
1237	case NUMBER_CMD:
1238	nDelete(&IDNUMBER(pp));
1239	break;
1240	case BIGINT_CMD:
1241	n_Delete(&IDNUMBER(pp),currRing->cf);
1242	break;
1243	case MAP_CMD:
1244	{
1245	map im = IDMAP(pp);
1246	omFree((ADDRESS)im->preimage);
1247	}
1248	// continue as ideal:
1249	case IDEAL_CMD:
1250	case MODUL_CMD:
1251	case MATRIX_CMD:
1252	idDelete(&IDIDEAL(pp));
1253	break;
1254	case PROC_CMD:
1255	case RESOLUTION_CMD:
1256	case STRING_CMD:
1257	omFree((ADDRESS)IDSTRING(pp));
1258	break;
1259	case LIST_CMD:
1260	IDLIST(pp)->Clean();
1261	break;
1262	case LINK_CMD:
1263	omFreeBin(IDLINK(pp),sip_link_bin);
1264	break;
1265	// case ring: cannot happen
1266	default:
1267	Werror("unknown type %d",p->Typ());
1268	return TRUE;
1269	}
1270	pp->typ=ALIAS_CMD;
1271	IDDATA(pp)=(char*)h->data;
1272	h->CleanUp();
1273	omFreeBin((ADDRESS)h, sleftv_bin);
1274	return FALSE;
1275	}
1276
1277	static BOOLEAN iiInternalExport (leftv v, int toLev)
1278	{
1279	idhdl h=(idhdl)v->data;
1280	//Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1281	if (IDLEV(h)==0)
1282	{
1283	if (!BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1284	}
1285	else
1286	{
1287	h=IDROOT->get(v->name,toLev);
1288	idhdl *root=&IDROOT;
1289	if ((h==NULL)&&(currRing!=NULL))
1290	{
1291	h=currRing->idroot->get(v->name,toLev);
1292	root=&currRing->idroot;
1293	}
1294	BOOLEAN keepring=FALSE;
1295	if ((h!=NULL)&&(IDLEV(h)==toLev))
1296	{
1297	if (IDTYP(h)==v->Typ())
1298	{
1299	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1300	&& (v->Data()==IDDATA(h)))
1301	{
1302	IDRING(h)->ref++;
1303	keepring=TRUE;
1304	IDLEV(h)=toLev;
1305	//WarnS("keepring");
1306	return FALSE;
1307	}
1308	if (BVERBOSE(V_REDEFINE))
1309	{
1310	Warn("redefining %s",IDID(h));
1311	}
1312	#ifdef USE_IILOCALRING
1313	if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1314	#else
1315	proclevel *p=procstack;
1316	while (p->next!=NULL) p=p->next;
1317	if ((p->cRing==IDRING(h)) && (!keepring))
1318	{
1319	p->cRing=NULL;
1320	p->cRingHdl=NULL;
1321	}
1322	#endif
1323	killhdl2(h,root,currRing);
1324	}
1325	else
1326	{
1327	return TRUE;
1328	}
1329	}
1330	h=(idhdl)v->data;
1331	IDLEV(h)=toLev;
1332	if (keepring) IDRING(h)->ref--;
1333	iiNoKeepRing=FALSE;
1334	//Print("export %s\n",IDID(h));
1335	}
1336	return FALSE;
1337	}
1338
1339	BOOLEAN iiInternalExport (leftv v, int toLev, idhdl roothdl)
1340	{
1341	idhdl h=(idhdl)v->data;
1342	if(h==NULL)
1343	{
1344	Warn("'%s': no such identifier\n", v->name);
1345	return FALSE;
1346	}
1347	package frompack=v->req_packhdl;
1348	if (frompack==NULL) frompack=currPack;
1349	package rootpack = IDPACKAGE(roothdl);
1350	// Print("iiInternalExport('%s',%d,%s->%s) typ:%d\n", v->name, toLev, IDID(currPackHdl),IDID(roothdl),v->Typ());
1351	if ((RingDependend(IDTYP(h)))
1352	\|\| ((IDTYP(h)==LIST_CMD)
1353	&& (lRingDependend(IDLIST(h)))
1354	)
1355	)
1356	{
1357	//Print("// ==> Ringdependent set nesting to 0\n");
1358	return (iiInternalExport(v, toLev));
1359	}
1360	else
1361	{
1362	IDLEV(h)=toLev;
1363	v->req_packhdl=rootpack;
1364	if (h==frompack->idroot)
1365	{
1366	frompack->idroot=h->next;
1367	}
1368	else
1369	{
1370	idhdl hh=frompack->idroot;
1371	while ((hh!=NULL) && (hh->next!=h))
1372	hh=hh->next;
1373	if ((hh!=NULL) && (hh->next==h))
1374	hh->next=h->next;
1375	else
1376	{
1377	Werror("`%s` not found",v->Name());
1378	return TRUE;
1379	}
1380	}
1381	h->next=rootpack->idroot;
1382	rootpack->idroot=h;
1383	}
1384	return FALSE;
1385	}
1386
1387	BOOLEAN iiExport (leftv v, int toLev)
1388	{
1389	#ifndef NDEBUG
1390	checkall();
1391	#endif
1392	BOOLEAN nok=FALSE;
1393	leftv r=v;
1394	while (v!=NULL)
1395	{
1396	if ((v->name==NULL)\|\|(v->rtyp==0)\|\|(v->e!=NULL))
1397	{
1398	WerrorS("cannot export");
1399	nok=TRUE;
1400	}
1401	else
1402	{
1403	if(iiInternalExport(v, toLev))
1404	{
1405	r->CleanUp();
1406	return TRUE;
1407	}
1408	}
1409	v=v->next;
1410	}
1411	r->CleanUp();
1412	#ifndef NDEBUG
1413	checkall();
1414	#endif
1415	return nok;
1416	}
1417
1418	/assume root!=idroot/
1419	BOOLEAN iiExport (leftv v, int toLev, idhdl root)
1420	{
1421	#ifndef NDEBUG
1422	checkall();
1423	#endif
1424	// Print("iiExport1: pack=%s\n",IDID(root));
1425	package pack=IDPACKAGE(root);
1426	BOOLEAN nok=FALSE;
1427	leftv rv=v;
1428	while (v!=NULL)
1429	{
1430	if ((v->name==NULL)\|\|(v->rtyp==0)\|\|(v->e!=NULL)
1431	)
1432	{
1433	WerrorS("cannot export");
1434	nok=TRUE;
1435	}
1436	else
1437	{
1438	idhdl old=pack->idroot->get( v->name,toLev);
1439	if (old!=NULL)
1440	{
1441	if ((pack==currPack) && (old==(idhdl)v->data))
1442	{
1443	if (!BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1444	break;
1445	}
1446	else if (IDTYP(old)==v->Typ())
1447	{
1448	if (BVERBOSE(V_REDEFINE))
1449	{
1450	Warn("redefining %s",IDID(old));
1451	}
1452	v->name=omStrDup(v->name);
1453	killhdl2(old,&(pack->idroot),currRing);
1454	}
1455	else
1456	{
1457	rv->CleanUp();
1458	return TRUE;
1459	}
1460	}
1461	//Print("iiExport: pack=%s\n",IDID(root));
1462	if(iiInternalExport(v, toLev, root))
1463	{
1464	rv->CleanUp();
1465	return TRUE;
1466	}
1467	}
1468	v=v->next;
1469	}
1470	rv->CleanUp();
1471	#ifndef NDEBUG
1472	checkall();
1473	#endif
1474	return nok;
1475	}
1476
1477	BOOLEAN iiCheckRing(int i)
1478	{
1479	if (currRing==NULL)
1480	{
1481	#ifdef SIQ
1482	if (siq<=0)
1483	{
1484	#endif
1485	if (RingDependend(i))
1486	{
1487	WerrorS("no ring active");
1488	return TRUE;
1489	}
1490	#ifdef SIQ
1491	}
1492	#endif
1493	}
1494	return FALSE;
1495	}
1496
1497	poly iiHighCorner(ideal I, int ak)
1498	{
1499	int i;
1500	if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1501	poly po=NULL;
1502	if (rHasLocalOrMixedOrdering_currRing())
1503	{
1504	scComputeHC(I,currQuotient,ak,po);
1505	if (po!=NULL)
1506	{
1507	pGetCoeff(po)=nInit(1);
1508	for (i=rVar(currRing); i>0; i--)
1509	{
1510	if (pGetExp(po, i) > 0) pDecrExp(po,i);
1511	}
1512	pSetComp(po,ak);
1513	pSetm(po);
1514	}
1515	}
1516	else
1517	po=pOne();
1518	return po;
1519	}
1520
1521	void iiCheckPack(package &p)
1522	{
1523	if (p==basePack) return;
1524
1525	idhdl t=basePack->idroot;
1526
1527	while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1528
1529	if (t==NULL)
1530	{
1531	WarnS("package not found\n");
1532	p=basePack;
1533	}
1534	return;
1535	}
1536
1537	idhdl rDefault(const char *s)
1538	{
1539	idhdl tmp=NULL;
1540
1541	if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1542	if (tmp==NULL) return NULL;
1543
1544	// if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1545	if (sLastPrinted.RingDependend())
1546	{
1547	sLastPrinted.CleanUp();
1548	memset(&sLastPrinted,0,sizeof(sleftv));
1549	}
1550
1551	ring r = IDRING(tmp);
1552
1553	r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1554	r->N = 3;
1555	/r->P = 0; Alloc0 in idhdl::set, ipid.cc/
1556	/names/
1557	r->names = (char *) omAlloc0(3 sizeof(char_ptr));
1558	r->names[0] = omStrDup("x");
1559	r->names[1] = omStrDup("y");
1560	r->names[2] = omStrDup("z");
1561	/weights: entries for 3 blocks: NULL/
1562	r->wvhdl = (int *)omAlloc0(3 sizeof(int_ptr));
1563	/order: dp,C,0/
1564	r->order = (int ) omAlloc(3 sizeof(int *));
1565	r->block0 = (int )omAlloc0(3 sizeof(int *));
1566	r->block1 = (int )omAlloc0(3 sizeof(int *));
1567	/* ringorder dp for the first block: var 1..3 */
1568	r->order[0] = ringorder_dp;
1569	r->block0[0] = 1;
1570	r->block1[0] = 3;
1571	/* ringorder C for the second block: no vars */
1572	r->order[1] = ringorder_C;
1573	/* the last block: everything is 0 */
1574	r->order[2] = 0;
1575	/polynomial ring/
1576	r->OrdSgn = 1;
1577
1578	/* complete ring intializations */
1579	rComplete(r);
1580	rSetHdl(tmp);
1581	return currRingHdl;
1582	}
1583
1584	idhdl rFindHdl(ring r, idhdl n, idhdl)
1585	{
1586	idhdl h=rSimpleFindHdl(r,IDROOT,n);
1587	if (h!=NULL) return h;
1588	if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1589	if (h!=NULL) return h;
1590	proclevel *p=procstack;
1591	while(p!=NULL)
1592	{
1593	if ((p->cPack!=basePack)
1594	&& (p->cPack!=currPack))
1595	h=rSimpleFindHdl(r,p->cPack->idroot,n);
1596	if (h!=NULL) return h;
1597	p=p->next;
1598	}
1599	idhdl tmp=basePack->idroot;
1600	while (tmp!=NULL)
1601	{
1602	if (IDTYP(tmp)==PACKAGE_CMD)
1603	h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1604	if (h!=NULL) return h;
1605	tmp=IDNEXT(tmp);
1606	}
1607	return NULL;
1608	}
1609
1610	void rDecomposeCF(leftv h,const ring r,const ring R)
1611	{
1612	lists L=(lists)omAlloc0Bin(slists_bin);
1613	L->Init(4);
1614	h->rtyp=LIST_CMD;
1615	h->data=(void *)L;
1616	// 0: char/ cf - ring
1617	// 1: list (var)
1618	// 2: list (ord)
1619	// 3: qideal
1620	// ----------------------------------------
1621	// 0: char/ cf - ring
1622	L->m[0].rtyp=INT_CMD;
1623	L->m[0].data=(void *)r->cf->ch;
1624	// ----------------------------------------
1625	// 1: list (var)
1626	lists LL=(lists)omAlloc0Bin(slists_bin);
1627	LL->Init(r->N);
1628	int i;
1629	for(i=0; i<r->N; i++)
1630	{
1631	LL->m[i].rtyp=STRING_CMD;
1632	LL->m[i].data=(void *)omStrDup(r->names[i]);
1633	}
1634	L->m[1].rtyp=LIST_CMD;
1635	L->m[1].data=(void *)LL;
1636	// ----------------------------------------
1637	// 2: list (ord)
1638	LL=(lists)omAlloc0Bin(slists_bin);
1639	i=rBlocks(r)-1;
1640	LL->Init(i);
1641	i--;
1642	lists LLL;
1643	for(; i>=0; i--)
1644	{
1645	intvec *iv;
1646	int j;
1647	LL->m[i].rtyp=LIST_CMD;
1648	LLL=(lists)omAlloc0Bin(slists_bin);
1649	LLL->Init(2);
1650	LLL->m[0].rtyp=STRING_CMD;
1651	LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1652	if (r->block1[i]-r->block0[i] >=0 )
1653	{
1654	j=r->block1[i]-r->block0[i];
1655	if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1656	iv=new intvec(j+1);
1657	if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1658	{
1659	for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1660	}
1661	else switch (r->order[i])
1662	{
1663	case ringorder_dp:
1664	case ringorder_Dp:
1665	case ringorder_ds:
1666	case ringorder_Ds:
1667	case ringorder_lp:
1668	for(;j>=0; j--) (*iv)[j]=1;
1669	break;
1670	default: /* do nothing */;
1671	}
1672	}
1673	else
1674	{
1675	iv=new intvec(1);
1676	}
1677	LLL->m[1].rtyp=INTVEC_CMD;
1678	LLL->m[1].data=(void *)iv;
1679	LL->m[i].data=(void *)LLL;
1680	}
1681	L->m[2].rtyp=LIST_CMD;
1682	L->m[2].data=(void *)LL;
1683	// ----------------------------------------
1684	// 3: qideal
1685	L->m[3].rtyp=IDEAL_CMD;
1686	if (nCoeff_is_transExt(R->cf))
1687	L->m[3].data=(void *)idInit(1,1);
1688	else
1689	{
1690	ideal q=idInit(IDELEMS(r->qideal));
1691	q->m[0]=p_Init(R);
1692	pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1693	L->m[3].data=(void *)q;
1694	// I->m[0] = pNSet(R->minpoly);
1695	}
1696	// ----------------------------------------
1697	}
1698	void rDecomposeC(leftv h,const ring R)
1699	/* field is R or C */
1700	{
1701	lists L=(lists)omAlloc0Bin(slists_bin);
1702	if (rField_is_long_C(R)) L->Init(3);
1703	else L->Init(2);
1704	h->rtyp=LIST_CMD;
1705	h->data=(void *)L;
1706	// 0: char/ cf - ring
1707	// 1: list (var)
1708	// 2: list (ord)
1709	// ----------------------------------------
1710	// 0: char/ cf - ring
1711	L->m[0].rtyp=INT_CMD;
1712	L->m[0].data=(void *)0;
1713	// ----------------------------------------
1714	// 1:
1715	lists LL=(lists)omAlloc0Bin(slists_bin);
1716	LL->Init(2);
1717	LL->m[0].rtyp=INT_CMD;
1718	LL->m[0].data=(void *)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1719	LL->m[1].rtyp=INT_CMD;
1720	LL->m[1].data=(void *)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1721	L->m[1].rtyp=LIST_CMD;
1722	L->m[1].data=(void *)LL;
1723	// ----------------------------------------
1724	// 2: list (par)
1725	if (rField_is_long_C(R))
1726	{
1727	L->m[2].rtyp=STRING_CMD;
1728	L->m[2].data=(void )omStrDup(rParameter(R));
1729	}
1730	// ----------------------------------------
1731	}
1732
1733	#ifdef HAVE_RINGS
1734	void rDecomposeRing(leftv h,const ring R)
1735	/* field is R or C */
1736	{
1737	lists L=(lists)omAlloc0Bin(slists_bin);
1738	if (rField_is_Ring_Z(R)) L->Init(1);
1739	else L->Init(2);
1740	h->rtyp=LIST_CMD;
1741	h->data=(void *)L;
1742	// 0: char/ cf - ring
1743	// 1: list (module)
1744	// ----------------------------------------
1745	// 0: char/ cf - ring
1746	L->m[0].rtyp=STRING_CMD;
1747	L->m[0].data=(void *)omStrDup("integer");
1748	// ----------------------------------------
1749	// 1: module
1750	if (rField_is_Ring_Z(R)) return;
1751	lists LL=(lists)omAlloc0Bin(slists_bin);
1752	LL->Init(2);
1753	LL->m[0].rtyp=BIGINT_CMD;
1754	LL->m[0].data=nlMapGMP((number) R->cf->modBase, R->cf, R->cf);
1755	LL->m[1].rtyp=INT_CMD;
1756	LL->m[1].data=(void *) R->cf->modExponent;
1757	L->m[1].rtyp=LIST_CMD;
1758	L->m[1].data=(void *)LL;
1759	}
1760	#endif
1761
1762
1763	lists rDecompose(const ring r)
1764	{
1765	assume( r != NULL );
1766	const coeffs C = r->cf;
1767	assume( C != NULL );
1768
1769	// sanity check: require currRing==r for rings with polynomial data
1770	if ( (r!=currRing) && (
1771	(nCoeff_is_algExt(C) && (C != currRing->cf))
1772	\|\| (r->qideal != NULL)
1773	#ifdef HAVE_PLURAL
1774	\|\| (rIsPluralRing(r))
1775	#endif
1776	)
1777	)
1778	{
1779	WerrorS("ring with polynomial data must be the base ring or compatible");
1780	return NULL;
1781	}
1782	// 0: char/ cf - ring
1783	// 1: list (var)
1784	// 2: list (ord)
1785	// 3: qideal
1786	// possibly:
1787	// 4: C
1788	// 5: D
1789	lists L=(lists)omAlloc0Bin(slists_bin);
1790	if (rIsPluralRing(r))
1791	L->Init(6);
1792	else
1793	L->Init(4);
1794	// ----------------------------------------
1795	// 0: char/ cf - ring
1796	if (rField_is_numeric(r))
1797	{
1798	rDecomposeC(&(L->m[0]),r);
1799	}
1800	#ifdef HAVE_RINGS
1801	else if (rField_is_Ring(r))
1802	{
1803	rDecomposeRing(&(L->m[0]),r);
1804	}
1805	#endif
1806	else if (rIsExtension(r))
1807	{
1808	if ( rField_is_Extension(r) )// nCoeff_is_algExt(r->cf))
1809	{
1810	assume( r->cf != NULL );
1811	assume( r->cf->extRing != NULL );
1812
1813	rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
1814	}
1815	else
1816	{
1817	assume( nCoeff_is_GF(r->cf) );
1818
1819	lists Lc=(lists)omAlloc0Bin(slists_bin);
1820	Lc->Init(4);
1821	// char:
1822	Lc->m[0].rtyp=INT_CMD;
1823	Lc->m[0].data=(void*)r->cf->m_nfCharQ;
1824	// var:
1825	lists Lv=(lists)omAlloc0Bin(slists_bin);
1826	Lv->Init(1);
1827	Lv->m[0].rtyp=STRING_CMD;
1828	Lv->m[0].data=(void )omStrDup(rParameter(r));
1829	Lc->m[1].rtyp=LIST_CMD;
1830	Lc->m[1].data=(void*)Lv;
1831	// ord:
1832	lists Lo=(lists)omAlloc0Bin(slists_bin);
1833	Lo->Init(1);
1834	lists Loo=(lists)omAlloc0Bin(slists_bin);
1835	Loo->Init(2);
1836	Loo->m[0].rtyp=STRING_CMD;
1837	Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1838
1839	intvec iv=new intvec(1); (iv)[0]=1;
1840	Loo->m[1].rtyp=INTVEC_CMD;
1841	Loo->m[1].data=(void *)iv;
1842
1843	Lo->m[0].rtyp=LIST_CMD;
1844	Lo->m[0].data=(void*)Loo;
1845
1846	Lc->m[2].rtyp=LIST_CMD;
1847	Lc->m[2].data=(void*)Lo;
1848	// q-ideal:
1849	Lc->m[3].rtyp=IDEAL_CMD;
1850	Lc->m[3].data=(void *)idInit(1,1);
1851	// ----------------------
1852	L->m[0].rtyp=LIST_CMD;
1853	L->m[0].data=(void*)Lc;
1854	}
1855	if (L->m[0].rtyp==0)
1856	{
1857	//omFreeBin(slists_bin,(void *)L);
1858	return NULL;
1859	}
1860	}
1861	else
1862	{
1863	L->m[0].rtyp=INT_CMD;
1864	L->m[0].data=(void *)r->cf->ch;
1865	}
1866	// ----------------------------------------
1867	// 1: list (var)
1868	lists LL=(lists)omAlloc0Bin(slists_bin);
1869	LL->Init(r->N);
1870	int i;
1871	for(i=0; i<r->N; i++)
1872	{
1873	LL->m[i].rtyp=STRING_CMD;
1874	LL->m[i].data=(void *)omStrDup(r->names[i]);
1875	}
1876	L->m[1].rtyp=LIST_CMD;
1877	L->m[1].data=(void *)LL;
1878	// ----------------------------------------
1879	// 2: list (ord)
1880	LL=(lists)omAlloc0Bin(slists_bin);
1881	i=rBlocks(r)-1;
1882	LL->Init(i);
1883	i--;
1884	lists LLL;
1885	for(; i>=0; i--)
1886	{
1887	intvec *iv;
1888	int j;
1889	LL->m[i].rtyp=LIST_CMD;
1890	LLL=(lists)omAlloc0Bin(slists_bin);
1891	LLL->Init(2);
1892	LLL->m[0].rtyp=STRING_CMD;
1893	LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1894
1895	if(r->order[i] == ringorder_IS) // \|\| r->order[i] == ringorder_s \|\| r->order[i] == ringorder_S)
1896	{
1897	assume( r->block0[i] == r->block1[i] );
1898	const int s = r->block0[i];
1899	assume( -2 < s && s < 2);
1900
1901	iv=new intvec(1);
1902	(*iv)[0] = s;
1903	}
1904	else if (r->block1[i]-r->block0[i] >=0 )
1905	{
1906	int bl=j=r->block1[i]-r->block0[i];
1907	if (r->order[i]==ringorder_M)
1908	{
1909	j=(j+1)*(j+1)-1;
1910	bl=j+1;
1911	}
1912	else if (r->order[i]==ringorder_am)
1913	{
1914	j+=r->wvhdl[i][bl+1];
1915	}
1916	iv=new intvec(j+1);
1917	if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1918	{
1919	for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1920	}
1921	else switch (r->order[i])
1922	{
1923	case ringorder_dp:
1924	case ringorder_Dp:
1925	case ringorder_ds:
1926	case ringorder_Ds:
1927	case ringorder_lp:
1928	for(;j>=0; j--) (*iv)[j]=1;
1929	break;
1930	default: /* do nothing */;
1931	}
1932	}
1933	else
1934	{
1935	iv=new intvec(1);
1936	}
1937	LLL->m[1].rtyp=INTVEC_CMD;
1938	LLL->m[1].data=(void *)iv;
1939	LL->m[i].data=(void *)LLL;
1940	}
1941	L->m[2].rtyp=LIST_CMD;
1942	L->m[2].data=(void *)LL;
1943	// ----------------------------------------
1944	// 3: qideal
1945	L->m[3].rtyp=IDEAL_CMD;
1946	if (r->qideal==NULL)
1947	L->m[3].data=(void *)idInit(1,1);
1948	else
1949	L->m[3].data=(void *)idCopy(r->qideal);
1950	// ----------------------------------------
1951	#ifdef HAVE_PLURAL // NC! in rDecompose
1952	if (rIsPluralRing(r))
1953	{
1954	L->m[4].rtyp=MATRIX_CMD;
1955	L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
1956	L->m[5].rtyp=MATRIX_CMD;
1957	L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
1958	}
1959	#endif
1960	return L;
1961	}
1962
1963	void rComposeC(lists L, ring R)
1964	/* field is R or C */
1965	{
1966	// ----------------------------------------
1967	// 0: char/ cf - ring
1968	if ((L->m[0].rtyp!=INT_CMD) \|\| (L->m[0].data!=(char *)0))
1969	{
1970	Werror("invald coeff. field description, expecting 0");
1971	return;
1972	}
1973	// R->cf->ch=0;
1974	// ----------------------------------------
1975	// 1:
1976	if (L->m[1].rtyp!=LIST_CMD)
1977	Werror("invald coeff. field description, expecting precision list");
1978	lists LL=(lists)L->m[1].data;
1979	int r1=(int)(long)LL->m[0].data;
1980	int r2=(int)(long)LL->m[1].data;
1981	if (L->nr==2) // complex
1982	R->cf = nInitChar(n_long_C, NULL);
1983	else if ((r1<=SHORT_REAL_LENGTH)
1984	&& (r2=SHORT_REAL_LENGTH))
1985	R->cf = nInitChar(n_R, NULL);
1986	else
1987	R->cf = nInitChar(n_long_R, NULL);
1988
1989	if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
1990	&& (r2=SHORT_REAL_LENGTH))
1991	{
1992	R->cf->float_len=SHORT_REAL_LENGTH/2;
1993	R->cf->float_len2=SHORT_REAL_LENGTH;
1994	}
1995	else
1996	{
1997	R->cf->float_len=si_min(r1,32767);
1998	R->cf->float_len2=si_min(r2,32767);
1999	}
2000	// ----------------------------------------
2001	// 2: list (par)
2002	if (L->nr==2)
2003	{
2004	R->cf->extRing->N=1;
2005	if (L->m[2].rtyp!=STRING_CMD)
2006	{
2007	Werror("invald coeff. field description, expecting parameter name");
2008	return;
2009	}
2010	R->cf->extRing->names=(char*)omAlloc0(rPar(R)sizeof(char_ptr));
2011	R->cf->extRing->names[0]=omStrDup((char *)L->m[2].data);
2012	}
2013	// ----------------------------------------
2014	}
2015
2016	#ifdef HAVE_RINGS
2017	void rComposeRing(lists L, ring R)
2018	/* field is R or C */
2019	{
2020	// ----------------------------------------
2021	// 0: string: integer
2022	// no further entries --> Z
2023	int_number modBase = NULL;
2024	unsigned int modExponent = 1;
2025
2026	modBase = (int_number) omAlloc(sizeof(mpz_t));
2027	if (L->nr == 0)
2028	{
2029	mpz_init_set_ui(modBase,0);
2030	modExponent = 1;
2031	}
2032	// ----------------------------------------
2033	// 1:
2034	else
2035	{
2036	if (L->m[1].rtyp!=LIST_CMD) Werror("invald data, expecting list of numbers");
2037	lists LL=(lists)L->m[1].data;
2038	if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2039	{
2040	number tmp= (number) LL->m[0].data;
2041	n_MPZ (modBase, tmp, coeffs_BIGINT);
2042	}
2043	else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2044	{
2045	mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2046	}
2047	else
2048	{
2049	mpz_init_set_ui(modBase,0);
2050	}
2051	if (LL->nr >= 1)
2052	{
2053	modExponent = (unsigned long) LL->m[1].data;
2054	}
2055	else
2056	{
2057	modExponent = 1;
2058	}
2059	}
2060	// ----------------------------------------
2061	if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2062	{
2063	Werror("Wrong ground ring specification (module is 1)");
2064	return;
2065	}
2066	if (modExponent < 1)
2067	{
2068	Werror("Wrong ground ring specification (exponent smaller than 1");
2069	return;
2070	}
2071	// module is 0 ---> integers
2072	if (mpz_cmp_ui(modBase, 0) == 0)
2073	{
2074	R->cf=nInitChar(n_Z,NULL);
2075	}
2076	// we have an exponent
2077	else if (modExponent > 1)
2078	{
2079	//R->cf->ch = R->cf->modExponent;
2080	if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(NATNUMBER)))
2081	{
2082	/* this branch should be active for modExponent = 2..32 resp. 2..64,
2083	depending on the size of a long on the respective platform */
2084	R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2085	omFreeSize (modBase, sizeof(mpz_t));
2086	}
2087	else
2088	{
2089	//ringtype 3
2090	ZnmInfo info;
2091	info.base= modBase;
2092	info.exp= modExponent;
2093	R->cf=nInitChar(n_Znm,(void*) &info);
2094	}
2095	}
2096	// just a module m > 1
2097	else
2098	{
2099	//ringtype = 2;
2100	//const int ch = mpz_get_ui(modBase);
2101	ZnmInfo info;
2102	info.base= modBase;
2103	info.exp= modExponent;
2104	R->cf=nInitChar(n_Zn,(void*) &info);
2105	}
2106	}
2107	#endif
2108
2109	static void rRenameVars(ring R)
2110	{
2111	int i,j;
2112	for(i=0;i<R->N-1;i++)
2113	{
2114	for(j=i+1;j<R->N;j++)
2115	{
2116	if (strcmp(R->names[i],R->names[j])==0)
2117	{
2118	Warn("name conflict var(%d) and var(%d): `%s`, rename to `@(%d)`",i+1,j+1,R->names[i],j+1);
2119	omFree(R->names[j]);
2120	R->names[j]=(char *)omAlloc(10);
2121	sprintf(R->names[j],"@(%d)",j+1);
2122	}
2123	}
2124	}
2125	for(i=0;i<rPar(R); i++)
2126	{
2127	for(j=0;j<R->N;j++)
2128	{
2129	if (strcmp(rParameter(R)[i],R->names[j])==0)
2130	{
2131	Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2132	// omFree(rParameter(R)[i]);
2133	// rParameter(R)[i]=(char *)omAlloc(10);
2134	// sprintf(rParameter(R)[i],"@@(%d)",i+1);
2135	omFree(R->names[j]);
2136	R->names[j]=(char *)omAlloc(10);
2137	sprintf(R->names[j],"@@(%d)",i+1);
2138	}
2139	}
2140	}
2141	}
2142
2143	ring rCompose(const lists L, const BOOLEAN check_comp)
2144	{
2145	if ((L->nr!=3)
2146	#ifdef HAVE_PLURAL
2147	&&(L->nr!=5)
2148	#endif
2149	)
2150	return NULL;
2151	int is_gf_char=0;
2152	// 0: char/ cf - ring
2153	// 1: list (var)
2154	// 2: list (ord)
2155	// 3: qideal
2156	// possibly:
2157	// 4: C
2158	// 5: D
2159
2160	ring R = (ring) omAlloc0Bin(sip_sring_bin);
2161
2162
2163	// ------------------------------------------------------------------
2164	// 0: char:
2165	if (L->m[0].Typ()==INT_CMD)
2166	{
2167	int ch = (int)(long)L->m[0].Data();
2168	assume( ch >= 0 );
2169
2170	if (ch == 0) // Q?
2171	R->cf = nInitChar(n_Q, NULL);
2172	else
2173	{
2174	int l = IsPrime(ch); // Zp?
2175	if( l != ch )
2176	{
2177	Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2178	ch = l;
2179	}
2180	R->cf = nInitChar(n_Zp, (void*)ch);
2181	}
2182	}
2183	else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2184	{
2185	lists LL=(lists)L->m[0].Data();
2186
2187	#ifdef HAVE_RINGS
2188	if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2189	{
2190	rComposeRing(LL, R); // Ring!?
2191	}
2192	else
2193	#endif
2194	if (LL->nr < 3)
2195	rComposeC(LL,R); // R, long_R, long_C
2196	else
2197	{
2198	if (LL->m[0].Typ()==INT_CMD)
2199	{
2200	int ch = (int)(long)LL->m[0].Data();
2201	while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2202	if (fftable[is_gf_char]==0) is_gf_char=-1;
2203
2204	if(is_gf_char!= -1)
2205	{
2206	GFInfo param;
2207
2208	param.GFChar = ch;
2209	param.GFDegree = 1;
2210	param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2211
2212	// nfInitChar should be able to handle the case when ch is in fftables!
2213	R->cf = nInitChar(n_GF, (void*)&param);
2214	}
2215	}
2216
2217	if( R->cf == NULL )
2218	{
2219	ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2220
2221	if (extRing==NULL)
2222	{
2223	WerrorS("could not create the specified coefficient field");
2224	goto rCompose_err;
2225	}
2226
2227	if( extRing->qideal != NULL ) // Algebraic extension
2228	{
2229	AlgExtInfo extParam;
2230
2231	extParam.r = extRing;
2232
2233	R->cf = nInitChar(n_algExt, (void*)&extParam);
2234	}
2235	else // Transcendental extension
2236	{
2237	TransExtInfo extParam;
2238	extParam.r = extRing;
2239	assume( extRing->qideal == NULL );
2240
2241	R->cf = nInitChar(n_transExt, &extParam);
2242	}
2243	}
2244	}
2245	}
2246	else
2247	{
2248	WerrorS("coefficient field must be described by `int` or `list`");
2249	goto rCompose_err;
2250	}
2251
2252	if( R->cf == NULL )
2253	{
2254	WerrorS("could not create coefficient field described by the input!");
2255	goto rCompose_err;
2256	}
2257
2258	// ------------------------- VARS ---------------------------
2259	if (L->m[1].Typ()==LIST_CMD)
2260	{
2261	lists v=(lists)L->m[1].Data();
2262	R->N = v->nr+1;
2263	R->names = (char *)omAlloc0(R->N sizeof(char_ptr));
2264	int i;
2265	for(i=0;i<R->N;i++)
2266	{
2267	if (v->m[i].Typ()==STRING_CMD)
2268	R->names[i]=omStrDup((char *)v->m[i].Data());
2269	else if (v->m[i].Typ()==POLY_CMD)
2270	{
2271	poly p=(poly)v->m[i].Data();
2272	int nr=pIsPurePower(p);
2273	if (nr>0)
2274	R->names[i]=omStrDup(currRing->names[nr-1]);
2275	else
2276	{
2277	Werror("var name %d must be a string or a ring variable",i+1);
2278	goto rCompose_err;
2279	}
2280	}
2281	else
2282	{
2283	Werror("var name %d must be `string`",i+1);
2284	goto rCompose_err;
2285	}
2286	}
2287	}
2288	else
2289	{
2290	WerrorS("variable must be given as `list`");
2291	goto rCompose_err;
2292	}
2293	// ------------------------ ORDER ------------------------------
2294	if (L->m[2].Typ()==LIST_CMD)
2295	{
2296	lists v=(lists)L->m[2].Data();
2297	int n= v->nr+2;
2298	int j;
2299	// initialize fields of R
2300	R->order=(int )omAlloc0(nsizeof(int));
2301	R->block0=(int )omAlloc0(nsizeof(int));
2302	R->block1=(int )omAlloc0(nsizeof(int));
2303	R->wvhdl=(int*)omAlloc0(nsizeof(int_ptr));
2304	// init order, so that rBlocks works correctly
2305	for (j=0; j < n-1; j++)
2306	R->order[j] = (int) ringorder_unspec;
2307	// orderings
2308	R->OrdSgn=1;
2309	for(j=0;j<n-1;j++)
2310	{
2311	// todo: a(..), M
2312	if (v->m[j].Typ()!=LIST_CMD)
2313	{
2314	WerrorS("ordering must be list of lists");
2315	goto rCompose_err;
2316	}
2317	lists vv=(lists)v->m[j].Data();
2318	if ((vv->nr!=1)
2319	\|\| (vv->m[0].Typ()!=STRING_CMD)
2320	\|\| ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)))
2321	{
2322	WerrorS("ordering name must be a (string,intvec)");
2323	goto rCompose_err;
2324	}
2325	R->order[j]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2326
2327	if (j==0) R->block0[0]=1;
2328	else
2329	{
2330	int jj=j-1;
2331	while((jj>=0)
2332	&& ((R->order[jj]== ringorder_a)
2333	\|\| (R->order[jj]== ringorder_aa)
2334	\|\| (R->order[jj]== ringorder_am)
2335	\|\| (R->order[jj]== ringorder_c)
2336	\|\| (R->order[jj]== ringorder_C)
2337	\|\| (R->order[jj]== ringorder_s)
2338	\|\| (R->order[jj]== ringorder_S)
2339	))
2340	{
2341	//Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2342	jj--;
2343	}
2344	if (jj<0) R->block0[j]=1;
2345	else R->block0[j]=R->block1[jj]+1;
2346	}
2347	intvec *iv;
2348	if (vv->m[1].Typ()==INT_CMD)
2349	iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2350	else
2351	iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2352	int iv_len=iv->length();
2353	R->block1[j]=si_max(R->block0[j],R->block0[j]+iv_len-1);
2354	if (R->block1[j]>R->N)
2355	{
2356	R->block1[j]=R->N;
2357	iv_len=R->block1[j]-R->block0[j]+1;
2358	}
2359	//Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2360	int i;
2361	switch (R->order[j])
2362	{
2363	case ringorder_ws:
2364	case ringorder_Ws:
2365	R->OrdSgn=-1;
2366	case ringorder_aa:
2367	case ringorder_a:
2368	case ringorder_wp:
2369	case ringorder_Wp:
2370	R->wvhdl[j] =( int )omAlloc(iv_lensizeof(int));
2371	for (i=0; i<iv_len;i++)
2372	{
2373	R->wvhdl[j][i]=(*iv)[i];
2374	}
2375	break;
2376	case ringorder_am:
2377	R->wvhdl[j] =( int )omAlloc((iv->length()+1)sizeof(int));
2378	for (i=0; i<iv_len;i++)
2379	{
2380	R->wvhdl[j][i]=(*iv)[i];
2381	}
2382	R->wvhdl[j][i]=iv->length() - iv_len;
2383	//printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2384	for (; i<iv->length(); i++)
2385	{
2386	R->wvhdl[j][i+1]=(*iv)[i];
2387	}
2388	break;
2389	case ringorder_M:
2390	R->wvhdl[j] =( int )omAlloc((iv->length())sizeof(int));
2391	for (i=0; i<iv->length();i++) R->wvhdl[j][i]=(*iv)[i];
2392	R->block1[j]=si_max(R->block0[j],R->block0[j]+(int)sqrt((double)(iv->length()-1)));
2393	if (R->block1[j]>R->N)
2394	{
2395	WerrorS("ordering matrix too big");
2396	goto rCompose_err;
2397	}
2398	break;
2399	case ringorder_ls:
2400	case ringorder_ds:
2401	case ringorder_Ds:
2402	case ringorder_rs:
2403	R->OrdSgn=-1;
2404	case ringorder_lp:
2405	case ringorder_dp:
2406	case ringorder_Dp:
2407	case ringorder_rp:
2408	break;
2409	case ringorder_S:
2410	break;
2411	case ringorder_c:
2412	case ringorder_C:
2413	R->block1[j]=R->block0[j]=0;
2414	break;
2415
2416	case ringorder_s:
2417	break;
2418
2419	case ringorder_IS:
2420	{
2421	R->block1[j] = R->block0[j] = 0;
2422	if( iv->length() > 0 )
2423	{
2424	const int s = (*iv)[0];
2425	assume( -2 < s && s < 2 );
2426	R->block1[j] = R->block0[j] = s;
2427	}
2428	break;
2429	}
2430	case 0:
2431	case ringorder_unspec:
2432	break;
2433	}
2434	delete iv;
2435	}
2436	// sanity check
2437	j=n-2;
2438	if ((R->order[j]==ringorder_c)
2439	\|\| (R->order[j]==ringorder_C)
2440	\|\| (R->order[j]==ringorder_unspec)) j--;
2441	if (R->block1[j] != R->N)
2442	{
2443	if (((R->order[j]==ringorder_dp) \|\|
2444	(R->order[j]==ringorder_ds) \|\|
2445	(R->order[j]==ringorder_Dp) \|\|
2446	(R->order[j]==ringorder_Ds) \|\|
2447	(R->order[j]==ringorder_rp) \|\|
2448	(R->order[j]==ringorder_rs) \|\|
2449	(R->order[j]==ringorder_lp) \|\|
2450	(R->order[j]==ringorder_ls))
2451	&&
2452	R->block0[j] <= R->N)
2453	{
2454	R->block1[j] = R->N;
2455	}
2456	else
2457	{
2458	Werror("ordering incomplete: size (%d) should be %d",R->block1[j],R->N);
2459	goto rCompose_err;
2460	}
2461	}
2462	if (check_comp)
2463	{
2464	BOOLEAN comp_order=FALSE;
2465	int jj;
2466	for(jj=0;jj<n;jj++)
2467	{
2468	if ((R->order[jj]==ringorder_c) \|\|
2469	(R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2470	}
2471	if (!comp_order)
2472	{
2473	R->order=(int)omRealloc0Size(R->order,nsizeof(int),(n+1)*sizeof(int));
2474	R->block0=(int)omRealloc0Size(R->block0,nsizeof(int),(n+1)*sizeof(int));
2475	R->block1=(int)omRealloc0Size(R->block1,nsizeof(int),(n+1)*sizeof(int));
2476	R->wvhdl=(int*)omRealloc0Size(R->wvhdl,nsizeof(int_ptr),(n+1)*sizeof(int_ptr));
2477	R->order[n-1]=ringorder_C;
2478	R->block0[n-1]=0;
2479	R->block1[n-1]=0;
2480	R->wvhdl[n-1]=NULL;
2481	n++;
2482	}
2483	}
2484	}
2485	else
2486	{
2487	WerrorS("ordering must be given as `list`");
2488	goto rCompose_err;
2489	}
2490
2491	// ------------------------ ??????? --------------------
2492
2493	rRenameVars(R);
2494	rComplete(R);
2495
2496	#ifdef HAVE_RINGS
2497	// currently, coefficients which are ring elements require a global ordering:
2498	if (rField_is_Ring(R) && (R->OrdSgn==-1))
2499	{
2500	WerrorS("global ordering required for these coefficients");
2501	goto rCompose_err;
2502	}
2503	#endif
2504
2505
2506	// ------------------------ Q-IDEAL ------------------------
2507
2508	if (L->m[3].Typ()==IDEAL_CMD)
2509	{
2510	ideal q=(ideal)L->m[3].Data();
2511	if (q->m[0]!=NULL)
2512	{
2513	if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2514	{
2515	#if 0
2516	WerrorS("coefficient fields must be equal if q-ideal !=0");
2517	goto rCompose_err;
2518	#else
2519	ring orig_ring=currRing;
2520	rChangeCurrRing(R);
2521	int *perm=NULL;
2522	int *par_perm=NULL;
2523	int par_perm_size=0;
2524	nMapFunc nMap;
2525
2526	if ((nMap=nSetMap(orig_ring->cf))==NULL)
2527	{
2528	if (rEqual(orig_ring,currRing))
2529	{
2530	nMap=n_SetMap(currRing->cf, currRing->cf);
2531	}
2532	else
2533	// Allow imap/fetch to be make an exception only for:
2534	if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) \|\| Q \|\| Zp \|\| Zp(a)
2535	(rField_is_Q(currRing) \|\| rField_is_Q_a(currRing) \|\|
2536	(rField_is_Zp(currRing) \|\| rField_is_Zp_a(currRing))))
2537	\|\|
2538	(rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) \|\| Zp
2539	(rField_is_Zp(currRing, rInternalChar(orig_ring)) \|\|
2540	rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2541	{
2542	par_perm_size=rPar(orig_ring);
2543
2544	// if ((orig_ring->minpoly != NULL) \|\| (orig_ring->qideal != NULL))
2545	// naSetChar(rInternalChar(orig_ring),orig_ring);
2546	// else ntSetChar(rInternalChar(orig_ring),orig_ring);
2547
2548	nSetChar(currRing->cf);
2549	}
2550	else
2551	{
2552	WerrorS("coefficient fields must be equal if q-ideal !=0");
2553	goto rCompose_err;
2554	}
2555	}
2556	perm=(int )omAlloc0((orig_ring->N+1)sizeof(int));
2557	if (par_perm_size!=0)
2558	par_perm=(int )omAlloc0(par_perm_sizesizeof(int));
2559	int i;
2560	#if 0
2561	// use imap:
2562	maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2563	currRing->names,currRing->N,currRing->parameter, currRing->P,
2564	perm,par_perm, currRing->ch);
2565	#else
2566	// use fetch
2567	if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2568	{
2569	for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2570	}
2571	else if (par_perm_size!=0)
2572	for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2573	for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2574	#endif
2575	ideal dest_id=idInit(IDELEMS(q),1);
2576	for(i=IDELEMS(q)-1; i>=0; i--)
2577	{
2578	dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2579	par_perm,par_perm_size);
2580	// PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2581	pTest(dest_id->m[i]);
2582	}
2583	R->qideal=dest_id;
2584	if (perm!=NULL)
2585	omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2586	if (par_perm!=NULL)
2587	omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2588	rChangeCurrRing(orig_ring);
2589	#endif
2590	}
2591	else
2592	R->qideal=idrCopyR(q,currRing,R);
2593	}
2594	}
2595	else
2596	{
2597	WerrorS("q-ideal must be given as `ideal`");
2598	goto rCompose_err;
2599	}
2600
2601
2602	// ---------------------------------------------------------------
2603	#ifdef HAVE_PLURAL
2604	if (L->nr==5)
2605	{
2606	if (nc_CallPlural((matrix)L->m[4].Data(),
2607	(matrix)L->m[5].Data(),
2608	NULL,NULL,
2609	R,
2610	true, // !!!
2611	true, false,
2612	currRing, FALSE)) goto rCompose_err;
2613	// takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2614	}
2615	#endif
2616	return R;
2617
2618	rCompose_err:
2619	if (R->N>0)
2620	{
2621	int i;
2622	if (R->names!=NULL)
2623	{
2624	i=R->N-1;
2625	while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2626	omFree(R->names);
2627	}
2628	}
2629	if (R->order!=NULL) omFree(R->order);
2630	if (R->block0!=NULL) omFree(R->block0);
2631	if (R->block1!=NULL) omFree(R->block1);
2632	if (R->wvhdl!=NULL) omFree(R->wvhdl);
2633	omFree(R);
2634	return NULL;
2635	}
2636
2637	// from matpol.cc
2638
2639	/*2
2640	* compute the jacobi matrix of an ideal
2641	*/
2642	BOOLEAN mpJacobi(leftv res,leftv a)
2643	{
2644	int i,j;
2645	matrix result;
2646	ideal id=(ideal)a->Data();
2647
2648	result =mpNew(IDELEMS(id),rVar(currRing));
2649	for (i=1; i<=IDELEMS(id); i++)
2650	{
2651	for (j=1; j<=rVar(currRing); j++)
2652	{
2653	MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2654	}
2655	}
2656	res->data=(char *)result;
2657	return FALSE;
2658	}
2659
2660	/*2
2661	* returns the Koszul-matrix of degree d of a vectorspace with dimension n
2662	* uses the first n entrees of id, if id <> NULL
2663	*/
2664	BOOLEAN mpKoszul(leftv res,leftv c/ip/, leftv b/in/, leftv id)
2665	{
2666	int n=(int)(long)b->Data();
2667	int d=(int)(long)c->Data();
2668	int k,l,sign,row,col;
2669	matrix result;
2670	ideal temp;
2671	BOOLEAN bo;
2672	poly p;
2673
2674	if ((d>n) \|\| (d<1) \|\| (n<1))
2675	{
2676	res->data=(char *)mpNew(1,1);
2677	return FALSE;
2678	}
2679	int choise = (int)omAlloc(d*sizeof(int));
2680	if (id==NULL)
2681	temp=idMaxIdeal(1);
2682	else
2683	temp=(ideal)id->Data();
2684
2685	k = binom(n,d);
2686	l = k*d;
2687	l /= n-d+1;
2688	result =mpNew(l,k);
2689	col = 1;
2690	idInitChoise(d,1,n,&bo,choise);
2691	while (!bo)
2692	{
2693	sign = 1;
2694	for (l=1;l<=d;l++)
2695	{
2696	if (choise[l-1]<=IDELEMS(temp))
2697	{
2698	p = pCopy(temp->m[choise[l-1]-1]);
2699	if (sign == -1) p = pNeg(p);
2700	sign *= -1;
2701	row = idGetNumberOfChoise(l-1,d,1,n,choise);
2702	MATELEM(result,row,col) = p;
2703	}
2704	}
2705	col++;
2706	idGetNextChoise(d,n,&bo,choise);
2707	}
2708	if (id==NULL) idDelete(&temp);
2709
2710	res->data=(char *)result;
2711	return FALSE;
2712	}
2713
2714	// from syz1.cc
2715	/*2
2716	* read out the Betti numbers from resolution
2717	* (interpreter interface)
2718	*/
2719	BOOLEAN syBetti2(leftv res, leftv u, leftv w)
2720	{
2721	syStrategy syzstr=(syStrategy)u->Data();
2722
2723	BOOLEAN minim=(int)(long)w->Data();
2724	int row_shift=0;
2725	int add_row_shift=0;
2726	intvec *weights=NULL;
2727	intvec ww=(intvec )atGet(u,"isHomog",INTVEC_CMD);
2728	if (ww!=NULL)
2729	{
2730	weights=ivCopy(ww);
2731	add_row_shift = ww->min_in();
2732	(*weights) -= add_row_shift;
2733	}
2734
2735	res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
2736	//row_shift += add_row_shift;
2737	//Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
2738	atSet(res,omStrDup("rowShift"),(void*)add_row_shift,INT_CMD);
2739
2740	return FALSE;
2741	}
2742	BOOLEAN syBetti1(leftv res, leftv u)
2743	{
2744	sleftv tmp;
2745	memset(&tmp,0,sizeof(tmp));
2746	tmp.rtyp=INT_CMD;
2747	tmp.data=(void *)1;
2748	return syBetti2(res,u,&tmp);
2749	}
2750
2751	/*3
2752	* converts a resolution into a list of modules
2753	*/
2754	lists syConvRes(syStrategy syzstr,BOOLEAN toDel,int add_row_shift)
2755	{
2756	resolvente fullres = syzstr->fullres;
2757	resolvente minres = syzstr->minres;
2758
2759	const int length = syzstr->length;
2760
2761	if ((fullres==NULL) && (minres==NULL))
2762	{
2763	if (syzstr->hilb_coeffs==NULL)
2764	{ // La Scala
2765	fullres = syReorder(syzstr->res, length, syzstr);
2766	}
2767	else
2768	{ // HRES
2769	minres = syReorder(syzstr->orderedRes, length, syzstr);
2770	syKillEmptyEntres(minres, length);
2771	}
2772	}
2773
2774	resolvente tr;
2775	int typ0=IDEAL_CMD;
2776
2777	if (minres!=NULL)
2778	tr = minres;
2779	else
2780	tr = fullres;
2781
2782	resolvente trueres=NULL; intvec ** w=NULL;
2783
2784	if (length>0)
2785	{
2786	trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
2787	for (int i=(length)-1;i>=0;i--)
2788	{
2789	if (tr[i]!=NULL)
2790	{
2791	trueres[i] = idCopy(tr[i]);
2792	}
2793	}
2794	if ( id_RankFreeModule(trueres[0], currRing) > 0)
2795	typ0 = MODUL_CMD;
2796	if (syzstr->weights!=NULL)
2797	{
2798	w = (intvec*)omAlloc0(lengthsizeof(intvec*));
2799	for (int i=length-1;i>=0;i--)
2800	{
2801	if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
2802	}
2803	}
2804	}
2805
2806	lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
2807	w, add_row_shift);
2808
2809	if (w != NULL) omFreeSize(w, lengthsizeof(intvec));
2810
2811	if (toDel)
2812	syKillComputation(syzstr);
2813	else
2814	{
2815	if( fullres != NULL && syzstr->fullres == NULL )
2816	syzstr->fullres = fullres;
2817
2818	if( minres != NULL && syzstr->minres == NULL )
2819	syzstr->minres = minres;
2820	}
2821
2822	return li;
2823
2824
2825	}
2826
2827	/*3
2828	* converts a list of modules into a resolution
2829	*/
2830	syStrategy syConvList(lists li,BOOLEAN toDel)
2831	{
2832	int typ0;
2833	syStrategy result=(syStrategy)omAlloc0(sizeof(ssyStrategy));
2834
2835	resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
2836	if (fr != NULL)
2837	{
2838
2839	result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
2840	for (int i=result->length-1;i>=0;i--)
2841	{
2842	if (fr[i]!=NULL)
2843	result->fullres[i] = idCopy(fr[i]);
2844	}
2845	result->list_length=result->length;
2846	omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
2847	}
2848	else
2849	{
2850	omFreeSize(result, sizeof(ssyStrategy));
2851	result = NULL;
2852	}
2853	if (toDel) li->Clean();
2854	return result;
2855	}
2856
2857	/*3
2858	* converts a list of modules into a minimal resolution
2859	*/
2860	syStrategy syForceMin(lists li)
2861	{
2862	int typ0;
2863	syStrategy result=(syStrategy)omAlloc0(sizeof(ssyStrategy));
2864
2865	resolvente fr = liFindRes(li,&(result->length),&typ0);
2866	result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
2867	for (int i=result->length-1;i>=0;i--)
2868	{
2869	if (fr[i]!=NULL)
2870	result->minres[i] = idCopy(fr[i]);
2871	}
2872	omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
2873	return result;
2874	}
2875	// from weight.cc
2876	BOOLEAN kWeight(leftv res,leftv id)
2877	{
2878	ideal F=(ideal)id->Data();
2879	intvec * iv = new intvec(rVar(currRing));
2880	polyset s;
2881	int sl, n, i;
2882	int *x;
2883
2884	res->data=(char *)iv;
2885	s = F->m;
2886	sl = IDELEMS(F) - 1;
2887	n = rVar(currRing);
2888	double wNsqr = (double)2.0 / (double)n;
2889	wFunctional = wFunctionalBuch;
2890	x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
2891	wCall(s, sl, x, wNsqr, currRing);
2892	for (i = n; i!=0; i--)
2893	(*iv)[i-1] = x[i + n + 1];
2894	omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
2895	return FALSE;
2896	}
2897
2898	BOOLEAN kQHWeight(leftv res,leftv v)
2899	{
2900	res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
2901	if (res->data==NULL)
2902	res->data=(char *)new intvec(rVar(currRing));
2903	return FALSE;
2904	}
2905	/==============================================================/
2906	// from clapsing.cc
2907	#if 0
2908	BOOLEAN jjIS_SQR_FREE(leftv res, leftv u)
2909	{
2910	BOOLEAN b=singclap_factorize((poly)(u->CopyD()), &v, 0);
2911	res->data=(void *)b;
2912	}
2913	#endif
2914
2915	BOOLEAN jjRESULTANT(leftv res, leftv u, leftv v, leftv w)
2916	{
2917	#ifdef HAVE_FACTORY
2918	res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
2919	(poly)w->CopyD(), currRing);
2920	return errorreported;
2921	#else
2922	Werror("Sorry: not yet re-factored: see libpolys/polys/clapsing.cc");
2923	return FALSE;
2924	#endif
2925	}
2926
2927	BOOLEAN jjCHARSERIES(leftv res, leftv u)
2928	{
2929	#if defined(HAVE_FACTORY) && defined(HAVE_LIBFAC)
2930	res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
2931	return (res->data==NULL);
2932	#else
2933	Werror("Sorry: not yet re-factored: see libpolys/polys/clapsing.cc");
2934	return FALSE;
2935	#endif
2936	}
2937
2938	// from semic.cc
2939	#ifdef HAVE_SPECTRUM
2940
2941	// ----------------------------------------------------------------------------
2942	// Initialize a spectrum deep from a singular lists
2943	// ----------------------------------------------------------------------------
2944
2945	void copy_deep( spectrum& spec, lists l )
2946	{
2947	spec.mu = (int)(long)(l->m[0].Data( ));
2948	spec.pg = (int)(long)(l->m[1].Data( ));
2949	spec.n = (int)(long)(l->m[2].Data( ));
2950
2951	spec.copy_new( spec.n );
2952
2953	intvec num = (intvec)l->m[3].Data( );
2954	intvec den = (intvec)l->m[4].Data( );
2955	intvec mul = (intvec)l->m[5].Data( );
2956
2957	for( int i=0; i<spec.n; i++ )
2958	{
2959	spec.s[i] = (Rational)((num)[i])/(Rational)((den)[i]);
2960	spec.w[i] = (*mul)[i];
2961	}
2962	}
2963
2964	// ----------------------------------------------------------------------------
2965	// singular lists constructor for spectrum
2966	// ----------------------------------------------------------------------------
2967
2968	spectrum /former spectrum::spectrum ( lists l )/
2969	spectrumFromList( lists l )
2970	{
2971	spectrum result;
2972	copy_deep( result, l );
2973	return result;
2974	}
2975
2976	// ----------------------------------------------------------------------------
2977	// generate a Singular lists from a spectrum
2978	// ----------------------------------------------------------------------------
2979
2980	/* former spectrum::thelist ( void )*/
2981	lists getList( spectrum& spec )
2982	{
2983	lists L = (lists)omAllocBin( slists_bin);
2984
2985	L->Init( 6 );
2986
2987	intvec *num = new intvec( spec.n );
2988	intvec *den = new intvec( spec.n );
2989	intvec *mult = new intvec( spec.n );
2990
2991	for( int i=0; i<spec.n; i++ )
2992	{
2993	(*num) [i] = spec.s[i].get_num_si( );
2994	(*den) [i] = spec.s[i].get_den_si( );
2995	(*mult)[i] = spec.w[i];
2996	}
2997
2998	L->m[0].rtyp = INT_CMD; // milnor number
2999	L->m[1].rtyp = INT_CMD; // geometrical genus
3000	L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3001	L->m[3].rtyp = INTVEC_CMD; // numerators
3002	L->m[4].rtyp = INTVEC_CMD; // denomiantors
3003	L->m[5].rtyp = INTVEC_CMD; // multiplicities
3004
3005	L->m[0].data = (void*)spec.mu;
3006	L->m[1].data = (void*)spec.pg;
3007	L->m[2].data = (void*)spec.n;
3008	L->m[3].data = (void*)num;
3009	L->m[4].data = (void*)den;
3010	L->m[5].data = (void*)mult;
3011
3012	return L;
3013	}
3014	// from spectrum.cc
3015	// ----------------------------------------------------------------------------
3016	// print out an error message for a spectrum list
3017	// ----------------------------------------------------------------------------
3018
3019	typedef enum
3020	{
3021	semicOK,
3022	semicMulNegative,
3023
3024	semicListTooShort,
3025	semicListTooLong,
3026
3027	semicListFirstElementWrongType,
3028	semicListSecondElementWrongType,
3029	semicListThirdElementWrongType,
3030	semicListFourthElementWrongType,
3031	semicListFifthElementWrongType,
3032	semicListSixthElementWrongType,
3033
3034	semicListNNegative,
3035	semicListWrongNumberOfNumerators,
3036	semicListWrongNumberOfDenominators,
3037	semicListWrongNumberOfMultiplicities,
3038
3039	semicListMuNegative,
3040	semicListPgNegative,
3041	semicListNumNegative,
3042	semicListDenNegative,
3043	semicListMulNegative,
3044
3045	semicListNotSymmetric,
3046	semicListNotMonotonous,
3047
3048	semicListMilnorWrong,
3049	semicListPGWrong
3050
3051	} semicState;
3052
3053	void list_error( semicState state )
3054	{
3055	switch( state )
3056	{
3057	case semicListTooShort:
3058	WerrorS( "the list is too short" );
3059	break;
3060	case semicListTooLong:
3061	WerrorS( "the list is too long" );
3062	break;
3063
3064	case semicListFirstElementWrongType:
3065	WerrorS( "first element of the list should be int" );
3066	break;
3067	case semicListSecondElementWrongType:
3068	WerrorS( "second element of the list should be int" );
3069	break;
3070	case semicListThirdElementWrongType:
3071	WerrorS( "third element of the list should be int" );
3072	break;
3073	case semicListFourthElementWrongType:
3074	WerrorS( "fourth element of the list should be intvec" );
3075	break;
3076	case semicListFifthElementWrongType:
3077	WerrorS( "fifth element of the list should be intvec" );
3078	break;
3079	case semicListSixthElementWrongType:
3080	WerrorS( "sixth element of the list should be intvec" );
3081	break;
3082
3083	case semicListNNegative:
3084	WerrorS( "first element of the list should be positive" );
3085	break;
3086	case semicListWrongNumberOfNumerators:
3087	WerrorS( "wrong number of numerators" );
3088	break;
3089	case semicListWrongNumberOfDenominators:
3090	WerrorS( "wrong number of denominators" );
3091	break;
3092	case semicListWrongNumberOfMultiplicities:
3093	WerrorS( "wrong number of multiplicities" );
3094	break;
3095
3096	case semicListMuNegative:
3097	WerrorS( "the Milnor number should be positive" );
3098	break;
3099	case semicListPgNegative:
3100	WerrorS( "the geometrical genus should be nonnegative" );
3101	break;
3102	case semicListNumNegative:
3103	WerrorS( "all numerators should be positive" );
3104	break;
3105	case semicListDenNegative:
3106	WerrorS( "all denominators should be positive" );
3107	break;
3108	case semicListMulNegative:
3109	WerrorS( "all multiplicities should be positive" );
3110	break;
3111
3112	case semicListNotSymmetric:
3113	WerrorS( "it is not symmetric" );
3114	break;
3115	case semicListNotMonotonous:
3116	WerrorS( "it is not monotonous" );
3117	break;
3118
3119	case semicListMilnorWrong:
3120	WerrorS( "the Milnor number is wrong" );
3121	break;
3122	case semicListPGWrong:
3123	WerrorS( "the geometrical genus is wrong" );
3124	break;
3125
3126	default:
3127	WerrorS( "unspecific error" );
3128	break;
3129	}
3130	}
3131	// ----------------------------------------------------------------------------
3132	// this is the main spectrum computation function
3133	// ----------------------------------------------------------------------------
3134
3135	enum spectrumState
3136	{
3137	spectrumOK,
3138	spectrumZero,
3139	spectrumBadPoly,
3140	spectrumNoSingularity,
3141	spectrumNotIsolated,
3142	spectrumDegenerate,
3143	spectrumWrongRing,
3144	spectrumNoHC,
3145	spectrumUnspecErr
3146	};
3147
3148	// from splist.cc
3149	// ----------------------------------------------------------------------------
3150	// Compute the spectrum of a spectrumPolyList
3151	// ----------------------------------------------------------------------------
3152
3153	/* former spectrumPolyList::spectrum ( lists, int) /
3154	spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L,int fast )
3155	{
3156	spectrumPolyNode **node = &speclist.root;
3157	spectrumPolyNode *search;
3158
3159	poly f,tmp;
3160	int found,cmp;
3161
3162	Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3163	( fast==2 ? 2 : 1 ) );
3164
3165	Rational weight_prev( 0,1 );
3166
3167	int mu = 0; // the milnor number
3168	int pg = 0; // the geometrical genus
3169	int n = 0; // number of different spectral numbers
3170	int z = 0; // number of spectral number equal to smax
3171
3172	while( (node)!=(spectrumPolyNode)NULL &&
3173	( fast==0 \|\| (*node)->weight<=smax ) )
3174	{
3175	// ---------------------------------------
3176	// determine the first normal form which
3177	// contains the monomial node->mon
3178	// ---------------------------------------
3179
3180	found = FALSE;
3181	search = *node;
3182
3183	while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3184	{
3185	if( search->nf!=(poly)NULL )
3186	{
3187	f = search->nf;
3188
3189	do
3190	{
3191	// --------------------------------
3192	// look for (*node)->mon in f
3193	// --------------------------------
3194
3195	cmp = pCmp( (*node)->mon,f );
3196
3197	if( cmp<0 )
3198	{
3199	f = pNext( f );
3200	}
3201	else if( cmp==0 )
3202	{
3203	// -----------------------------
3204	// we have found a normal form
3205	// -----------------------------
3206
3207	found = TRUE;
3208
3209	// normalize coefficient
3210
3211	number inv = nInvers( pGetCoeff( f ) );
3212	pMult_nn( search->nf,inv );
3213	nDelete( &inv );
3214
3215	// exchange normal forms
3216
3217	tmp = (*node)->nf;
3218	(*node)->nf = search->nf;
3219	search->nf = tmp;
3220	}
3221	}
3222	while( cmp<0 && f!=(poly)NULL );
3223	}
3224	search = search->next;
3225	}
3226
3227	if( found==FALSE )
3228	{
3229	// ------------------------------------------------
3230	// the weight of node->mon is a spectrum number
3231	// ------------------------------------------------
3232
3233	mu++;
3234
3235	if( (*node)->weight<=(Rational)1 ) pg++;
3236	if( (*node)->weight==smax ) z++;
3237	if( (*node)->weight>weight_prev ) n++;
3238
3239	weight_prev = (*node)->weight;
3240	node = &((*node)->next);
3241	}
3242	else
3243	{
3244	// -----------------------------------------------
3245	// determine all other normal form which contain
3246	// the monomial node->mon
3247	// replace for node->mon its normal form
3248	// -----------------------------------------------
3249
3250	while( search!=(spectrumPolyNode*)NULL )
3251	{
3252	if( search->nf!=(poly)NULL )
3253	{
3254	f = search->nf;
3255
3256	do
3257	{
3258	// --------------------------------
3259	// look for (*node)->mon in f
3260	// --------------------------------
3261
3262	cmp = pCmp( (*node)->mon,f );
3263
3264	if( cmp<0 )
3265	{
3266	f = pNext( f );
3267	}
3268	else if( cmp==0 )
3269	{
3270	search->nf = pSub( search->nf,
3271	ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3272	pNorm( search->nf );
3273	}
3274	}
3275	while( cmp<0 && f!=(poly)NULL );
3276	}
3277	search = search->next;
3278	}
3279	speclist.delete_node( node );
3280	}
3281
3282	}
3283
3284	// --------------------------------------------------------
3285	// fast computation exploits the symmetry of the spectrum
3286	// --------------------------------------------------------
3287
3288	if( fast==2 )
3289	{
3290	mu = 2*mu - z;
3291	n = ( z > 0 ? 2n - 1 : 2n );
3292	}
3293
3294	// --------------------------------------------------------
3295	// compute the spectrum numbers with their multiplicities
3296	// --------------------------------------------------------
3297
3298	intvec *nom = new intvec( n );
3299	intvec *den = new intvec( n );
3300	intvec *mult = new intvec( n );
3301
3302	int count = 0;
3303	int multiplicity = 1;
3304
3305	for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3306	( fast==0 \|\| search->weight<=smax );
3307	search=search->next )
3308	{
3309	if( search->next==(spectrumPolyNode*)NULL \|\|
3310	search->weight<search->next->weight )
3311	{
3312	(*nom) [count] = search->weight.get_num_si( );
3313	(*den) [count] = search->weight.get_den_si( );
3314	(*mult)[count] = multiplicity;
3315
3316	multiplicity=1;
3317	count++;
3318	}
3319	else
3320	{
3321	multiplicity++;
3322	}
3323	}
3324
3325	// --------------------------------------------------------
3326	// fast computation exploits the symmetry of the spectrum
3327	// --------------------------------------------------------
3328
3329	if( fast==2 )
3330	{
3331	int n1,n2;
3332	for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3333	{
3334	(nom) [n2] = rVar(currRing)(den)[n1]-(nom)[n1];
3335	(den) [n2] = (den)[n1];
3336	(mult)[n2] = (mult)[n1];
3337	}
3338	}
3339
3340	// -----------------------------------
3341	// test if the spectrum is symmetric
3342	// -----------------------------------
3343
3344	if( fast==0 \|\| fast==1 )
3345	{
3346	int symmetric=TRUE;
3347
3348	for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3349	{
3350	if( (mult)[n1]!=(mult)[n2] \|\|
3351	(den) [n1]!= (den)[n2] \|\|
3352	(nom)[n1]+(nom)[n2]!=rVar(currRing)(den) [n1] )
3353	{
3354	symmetric = FALSE;
3355	}
3356	}
3357
3358	if( symmetric==FALSE )
3359	{
3360	// ---------------------------------------------
3361	// the spectrum is not symmetric => degenerate
3362	// principal part
3363	// ---------------------------------------------
3364
3365	*L = (lists)omAllocBin( slists_bin);
3366	(*L)->Init( 1 );
3367	(*L)->m[0].rtyp = INT_CMD; // milnor number
3368	(L)->m[0].data = (void)mu;
3369
3370	return spectrumDegenerate;
3371	}
3372	}
3373
3374	*L = (lists)omAllocBin( slists_bin);
3375
3376	(*L)->Init( 6 );
3377
3378	(*L)->m[0].rtyp = INT_CMD; // milnor number
3379	(*L)->m[1].rtyp = INT_CMD; // geometrical genus
3380	(*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3381	(*L)->m[3].rtyp = INTVEC_CMD; // nominators
3382	(*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3383	(*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3384
3385	(L)->m[0].data = (void)mu;
3386	(L)->m[1].data = (void)pg;
3387	(L)->m[2].data = (void)n;
3388	(L)->m[3].data = (void)nom;
3389	(L)->m[4].data = (void)den;
3390	(L)->m[5].data = (void)mult;
3391
3392	return spectrumOK;
3393	}
3394
3395	spectrumState spectrumCompute( poly h,lists *L,int fast )
3396	{
3397	int i;
3398
3399	#ifdef SPECTRUM_DEBUG
3400	#ifdef SPECTRUM_PRINT
3401	#ifdef SPECTRUM_IOSTREAM
3402	cout << "spectrumCompute\n";
3403	if( fast==0 ) cout << " no optimization" << endl;
3404	if( fast==1 ) cout << " weight optimization" << endl;
3405	if( fast==2 ) cout << " symmetry optimization" << endl;
3406	#else
3407	fprintf( stdout,"spectrumCompute\n" );
3408	if( fast==0 ) fprintf( stdout," no optimization\n" );
3409	if( fast==1 ) fprintf( stdout," weight optimization\n" );
3410	if( fast==2 ) fprintf( stdout," symmetry optimization\n" );
3411	#endif
3412	#endif
3413	#endif
3414
3415	// ----------------------
3416	// check if h is zero
3417	// ----------------------
3418
3419	if( h==(poly)NULL )
3420	{
3421	return spectrumZero;
3422	}
3423
3424	// ----------------------------------
3425	// check if h has a constant term
3426	// ----------------------------------
3427
3428	if( hasConstTerm( h, currRing ) )
3429	{
3430	return spectrumBadPoly;
3431	}
3432
3433	// --------------------------------
3434	// check if h has a linear term
3435	// --------------------------------
3436
3437	if( hasLinearTerm( h, currRing ) )
3438	{
3439	*L = (lists)omAllocBin( slists_bin);
3440	(*L)->Init( 1 );
3441	(*L)->m[0].rtyp = INT_CMD; // milnor number
3442	/* (L)->m[0].data = (void)0;a -- done by Init */
3443
3444	return spectrumNoSingularity;
3445	}
3446
3447	// ----------------------------------
3448	// compute the jacobi ideal of (h)
3449	// ----------------------------------
3450
3451	ideal J = NULL;
3452	J = idInit( rVar(currRing),1 );
3453
3454	#ifdef SPECTRUM_DEBUG
3455	#ifdef SPECTRUM_PRINT
3456	#ifdef SPECTRUM_IOSTREAM
3457	cout << "\n computing the Jacobi ideal...\n";
3458	#else
3459	fprintf( stdout,"\n computing the Jacobi ideal...\n" );
3460	#endif
3461	#endif
3462	#endif
3463
3464	for( i=0; i<rVar(currRing); i++ )
3465	{
3466	J->m[i] = pDiff( h,i+1); //j );
3467
3468	#ifdef SPECTRUM_DEBUG
3469	#ifdef SPECTRUM_PRINT
3470	#ifdef SPECTRUM_IOSTREAM
3471	cout << " ";
3472	#else
3473	fprintf( stdout," " );
3474	#endif
3475	pWrite( J->m[i] );
3476	#endif
3477	#endif
3478	}
3479
3480	// --------------------------------------------
3481	// compute a standard basis stdJ of jac(h)
3482	// --------------------------------------------
3483
3484	#ifdef SPECTRUM_DEBUG
3485	#ifdef SPECTRUM_PRINT
3486	#ifdef SPECTRUM_IOSTREAM
3487	cout << endl;
3488	cout << " computing a standard basis..." << endl;
3489	#else
3490	fprintf( stdout,"\n" );
3491	fprintf( stdout," computing a standard basis...\n" );
3492	#endif
3493	#endif
3494	#endif
3495
3496	ideal stdJ = kStd(J,currQuotient,isNotHomog,NULL);
3497	idSkipZeroes( stdJ );
3498
3499	#ifdef SPECTRUM_DEBUG
3500	#ifdef SPECTRUM_PRINT
3501	for( i=0; i<IDELEMS(stdJ); i++ )
3502	{
3503	#ifdef SPECTRUM_IOSTREAM
3504	cout << " ";
3505	#else
3506	fprintf( stdout," " );
3507	#endif
3508
3509	pWrite( stdJ->m[i] );
3510	}
3511	#endif
3512	#endif
3513
3514	idDelete( &J );
3515
3516	// ------------------------------------------
3517	// check if the h has a singularity
3518	// ------------------------------------------
3519
3520	if( hasOne( stdJ, currRing ) )
3521	{
3522	// -------------------------------
3523	// h is smooth in the origin
3524	// return only the Milnor number
3525	// -------------------------------
3526
3527	*L = (lists)omAllocBin( slists_bin);
3528	(*L)->Init( 1 );
3529	(*L)->m[0].rtyp = INT_CMD; // milnor number
3530	/* (L)->m[0].data = (void)0;a -- done by Init */
3531
3532	return spectrumNoSingularity;
3533	}
3534
3535	// ------------------------------------------
3536	// check if the singularity h is isolated
3537	// ------------------------------------------
3538
3539	for( i=rVar(currRing); i>0; i-- )
3540	{
3541	if( hasAxis( stdJ,i, currRing )==FALSE )
3542	{
3543	return spectrumNotIsolated;
3544	}
3545	}
3546
3547	// ------------------------------------------
3548	// compute the highest corner hc of stdJ
3549	// ------------------------------------------
3550
3551	#ifdef SPECTRUM_DEBUG
3552	#ifdef SPECTRUM_PRINT
3553	#ifdef SPECTRUM_IOSTREAM
3554	cout << "\n computing the highest corner...\n";
3555	#else
3556	fprintf( stdout,"\n computing the highest corner...\n" );
3557	#endif
3558	#endif
3559	#endif
3560
3561	poly hc = (poly)NULL;
3562
3563	scComputeHC( stdJ,currQuotient, 0,hc );
3564
3565	if( hc!=(poly)NULL )
3566	{
3567	pGetCoeff(hc) = nInit(1);
3568
3569	for( i=rVar(currRing); i>0; i-- )
3570	{
3571	if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3572	}
3573	pSetm( hc );
3574	}
3575	else
3576	{
3577	return spectrumNoHC;
3578	}
3579
3580	#ifdef SPECTRUM_DEBUG
3581	#ifdef SPECTRUM_PRINT
3582	#ifdef SPECTRUM_IOSTREAM
3583	cout << " ";
3584	#else
3585	fprintf( stdout," " );
3586	#endif
3587	pWrite( hc );
3588	#endif
3589	#endif
3590
3591	// ----------------------------------------
3592	// compute the Newton polygon nph of h
3593	// ----------------------------------------
3594
3595	#ifdef SPECTRUM_DEBUG
3596	#ifdef SPECTRUM_PRINT
3597	#ifdef SPECTRUM_IOSTREAM
3598	cout << "\n computing the newton polygon...\n";
3599	#else
3600	fprintf( stdout,"\n computing the newton polygon...\n" );
3601	#endif
3602	#endif
3603	#endif
3604
3605	newtonPolygon nph( h, currRing );
3606
3607	#ifdef SPECTRUM_DEBUG
3608	#ifdef SPECTRUM_PRINT
3609	cout << nph;
3610	#endif
3611	#endif
3612
3613	// -----------------------------------------------
3614	// compute the weight corner wc of (stdj,nph)
3615	// -----------------------------------------------
3616
3617	#ifdef SPECTRUM_DEBUG
3618	#ifdef SPECTRUM_PRINT
3619	#ifdef SPECTRUM_IOSTREAM
3620	cout << "\n computing the weight corner...\n";
3621	#else
3622	fprintf( stdout,"\n computing the weight corner...\n" );
3623	#endif
3624	#endif
3625	#endif
3626
3627	poly wc = ( fast==0 ? pCopy( hc ) :
3628	( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3629	/* fast==2 */computeWC( nph,
3630	((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3631
3632	#ifdef SPECTRUM_DEBUG
3633	#ifdef SPECTRUM_PRINT
3634	#ifdef SPECTRUM_IOSTREAM
3635	cout << " ";
3636	#else
3637	fprintf( stdout," " );
3638	#endif
3639	pWrite( wc );
3640	#endif
3641	#endif
3642
3643	// -------------
3644	// compute NF
3645	// -------------
3646
3647	#ifdef SPECTRUM_DEBUG
3648	#ifdef SPECTRUM_PRINT
3649	#ifdef SPECTRUM_IOSTREAM
3650	cout << "\n computing NF...\n" << endl;
3651	#else
3652	fprintf( stdout,"\n computing NF...\n" );
3653	#endif
3654	#endif
3655	#endif
3656
3657	spectrumPolyList NF( &nph );
3658
3659	computeNF( stdJ,hc,wc,&NF, currRing );
3660
3661	#ifdef SPECTRUM_DEBUG
3662	#ifdef SPECTRUM_PRINT
3663	cout << NF;
3664	#ifdef SPECTRUM_IOSTREAM
3665	cout << endl;
3666	#else
3667	fprintf( stdout,"\n" );
3668	#endif
3669	#endif
3670	#endif
3671
3672	// ----------------------------
3673	// compute the spectrum of h
3674	// ----------------------------
3675	// spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
3676
3677	return spectrumStateFromList(NF, L, fast );
3678	}
3679
3680	// ----------------------------------------------------------------------------
3681	// this procedure is called from the interpreter
3682	// ----------------------------------------------------------------------------
3683	// first = polynomial
3684	// result = list of spectrum numbers
3685	// ----------------------------------------------------------------------------
3686
3687	void spectrumPrintError(spectrumState state)
3688	{
3689	switch( state )
3690	{
3691	case spectrumZero:
3692	WerrorS( "polynomial is zero" );
3693	break;
3694	case spectrumBadPoly:
3695	WerrorS( "polynomial has constant term" );
3696	break;
3697	case spectrumNoSingularity:
3698	WerrorS( "not a singularity" );
3699	break;
3700	case spectrumNotIsolated:
3701	WerrorS( "the singularity is not isolated" );
3702	break;
3703	case spectrumNoHC:
3704	WerrorS( "highest corner cannot be computed" );
3705	break;
3706	case spectrumDegenerate:
3707	WerrorS( "principal part is degenerate" );
3708	break;
3709	case spectrumOK:
3710	break;
3711
3712	default:
3713	WerrorS( "unknown error occurred" );
3714	break;
3715	}
3716	}
3717
3718	BOOLEAN spectrumProc( leftv result,leftv first )
3719	{
3720	spectrumState state = spectrumOK;
3721
3722	// -------------------
3723	// check consistency
3724	// -------------------
3725
3726	// check for a local ring
3727
3728	if( !ringIsLocal(currRing ) )
3729	{
3730	WerrorS( "only works for local orderings" );
3731	state = spectrumWrongRing;
3732	}
3733
3734	// no quotient rings are allowed
3735
3736	else if( currRing->qideal != NULL )
3737	{
3738	WerrorS( "does not work in quotient rings" );
3739	state = spectrumWrongRing;
3740	}
3741	else
3742	{
3743	lists L = (lists)NULL;
3744	int flag = 1; // weight corner optimization is safe
3745
3746	state = spectrumCompute( (poly)first->Data( ),&L,flag );
3747
3748	if( state==spectrumOK )
3749	{
3750	result->rtyp = LIST_CMD;
3751	result->data = (char*)L;
3752	}
3753	else
3754	{
3755	spectrumPrintError(state);
3756	}
3757	}
3758
3759	return (state!=spectrumOK);
3760	}
3761
3762	// ----------------------------------------------------------------------------
3763	// this procedure is called from the interpreter
3764	// ----------------------------------------------------------------------------
3765	// first = polynomial
3766	// result = list of spectrum numbers
3767	// ----------------------------------------------------------------------------
3768
3769	BOOLEAN spectrumfProc( leftv result,leftv first )
3770	{
3771	spectrumState state = spectrumOK;
3772
3773	// -------------------
3774	// check consistency
3775	// -------------------
3776
3777	// check for a local polynomial ring
3778
3779	if( currRing->OrdSgn != -1 )
3780	// ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
3781	// or should we use:
3782	//if( !ringIsLocal( ) )
3783	{
3784	WerrorS( "only works for local orderings" );
3785	state = spectrumWrongRing;
3786	}
3787	else if( currRing->qideal != NULL )
3788	{
3789	WerrorS( "does not work in quotient rings" );
3790	state = spectrumWrongRing;
3791	}
3792	else
3793	{
3794	lists L = (lists)NULL;
3795	int flag = 2; // symmetric optimization
3796
3797	state = spectrumCompute( (poly)first->Data( ),&L,flag );
3798
3799	if( state==spectrumOK )
3800	{
3801	result->rtyp = LIST_CMD;
3802	result->data = (char*)L;
3803	}
3804	else
3805	{
3806	spectrumPrintError(state);
3807	}
3808	}
3809
3810	return (state!=spectrumOK);
3811	}
3812
3813	// ----------------------------------------------------------------------------
3814	// check if a list is a spectrum
3815	// check for:
3816	// list has 6 elements
3817	// 1st element is int (mu=Milnor number)
3818	// 2nd element is int (pg=geometrical genus)
3819	// 3rd element is int (n =number of different spectrum numbers)
3820	// 4th element is intvec (num=numerators)
3821	// 5th element is intvec (den=denomiantors)
3822	// 6th element is intvec (mul=multiplicities)
3823	// exactly n numerators
3824	// exactly n denominators
3825	// exactly n multiplicities
3826	// mu>0
3827	// pg>=0
3828	// n>0
3829	// num>0
3830	// den>0
3831	// mul>0
3832	// symmetriy with respect to numberofvariables/2
3833	// monotony
3834	// mu = sum of all multiplicities
3835	// pg = sum of all multiplicities where num/den<=1
3836	// ----------------------------------------------------------------------------
3837
3838	semicState list_is_spectrum( lists l )
3839	{
3840	// -------------------
3841	// check list length
3842	// -------------------
3843
3844	if( l->nr < 5 )
3845	{
3846	return semicListTooShort;
3847	}
3848	else if( l->nr > 5 )
3849	{
3850	return semicListTooLong;
3851	}
3852
3853	// -------------
3854	// check types
3855	// -------------
3856
3857	if( l->m[0].rtyp != INT_CMD )
3858	{
3859	return semicListFirstElementWrongType;
3860	}
3861	else if( l->m[1].rtyp != INT_CMD )
3862	{
3863	return semicListSecondElementWrongType;
3864	}
3865	else if( l->m[2].rtyp != INT_CMD )
3866	{
3867	return semicListThirdElementWrongType;
3868	}
3869	else if( l->m[3].rtyp != INTVEC_CMD )
3870	{
3871	return semicListFourthElementWrongType;
3872	}
3873	else if( l->m[4].rtyp != INTVEC_CMD )
3874	{
3875	return semicListFifthElementWrongType;
3876	}
3877	else if( l->m[5].rtyp != INTVEC_CMD )
3878	{
3879	return semicListSixthElementWrongType;
3880	}
3881
3882	// -------------------------
3883	// check number of entries
3884	// -------------------------
3885
3886	int mu = (int)(long)(l->m[0].Data( ));
3887	int pg = (int)(long)(l->m[1].Data( ));
3888	int n = (int)(long)(l->m[2].Data( ));
3889
3890	if( n <= 0 )
3891	{
3892	return semicListNNegative;
3893	}
3894
3895	intvec num = (intvec)l->m[3].Data( );
3896	intvec den = (intvec)l->m[4].Data( );
3897	intvec mul = (intvec)l->m[5].Data( );
3898
3899	if( n != num->length( ) )
3900	{
3901	return semicListWrongNumberOfNumerators;
3902	}
3903	else if( n != den->length( ) )
3904	{
3905	return semicListWrongNumberOfDenominators;
3906	}
3907	else if( n != mul->length( ) )
3908	{
3909	return semicListWrongNumberOfMultiplicities;
3910	}
3911
3912	// --------
3913	// values
3914	// --------
3915
3916	if( mu <= 0 )
3917	{
3918	return semicListMuNegative;
3919	}
3920	if( pg < 0 )
3921	{
3922	return semicListPgNegative;
3923	}
3924
3925	int i;
3926
3927	for( i=0; i<n; i++ )
3928	{
3929	if( (*num)[i] <= 0 )
3930	{
3931	return semicListNumNegative;
3932	}
3933	if( (*den)[i] <= 0 )
3934	{
3935	return semicListDenNegative;
3936	}
3937	if( (*mul)[i] <= 0 )
3938	{
3939	return semicListMulNegative;
3940	}
3941	}
3942
3943	// ----------------
3944	// check symmetry
3945	// ----------------
3946
3947	int j;
3948
3949	for( i=0, j=n-1; i<=j; i++,j-- )
3950	{
3951	if( (num)[i] != rVar(currRing)((den)[i]) - (num)[j] \|\|
3952	(den)[i] != (den)[j] \|\|
3953	(mul)[i] != (mul)[j] )
3954	{
3955	return semicListNotSymmetric;
3956	}
3957	}
3958
3959	// ----------------
3960	// check monotony
3961	// ----------------
3962
3963	for( i=0, j=1; i<n/2; i++,j++ )
3964	{
3965	if( (num)[i](den)[j] >= (num)[j](den)[i] )
3966	{
3967	return semicListNotMonotonous;
3968	}
3969	}
3970
3971	// ---------------------
3972	// check Milnor number
3973	// ---------------------
3974
3975	for( mu=0, i=0; i<n; i++ )
3976	{
3977	mu += (*mul)[i];
3978	}
3979
3980	if( mu != (int)(long)(l->m[0].Data( )) )
3981	{
3982	return semicListMilnorWrong;
3983	}
3984
3985	// -------------------------
3986	// check geometrical genus
3987	// -------------------------
3988
3989	for( pg=0, i=0; i<n; i++ )
3990	{
3991	if( (num)[i]<=(den)[i] )
3992	{
3993	pg += (*mul)[i];
3994	}
3995	}
3996
3997	if( pg != (int)(long)(l->m[1].Data( )) )
3998	{
3999	return semicListPGWrong;
4000	}
4001
4002	return semicOK;
4003	}
4004
4005	// ----------------------------------------------------------------------------
4006	// this procedure is called from the interpreter
4007	// ----------------------------------------------------------------------------
4008	// first = list of spectrum numbers
4009	// second = list of spectrum numbers
4010	// result = sum of the two lists
4011	// ----------------------------------------------------------------------------
4012
4013	BOOLEAN spaddProc( leftv result,leftv first,leftv second )
4014	{
4015	semicState state;
4016
4017	// -----------------
4018	// check arguments
4019	// -----------------
4020
4021	lists l1 = (lists)first->Data( );
4022	lists l2 = (lists)second->Data( );
4023
4024	if( (state=list_is_spectrum( l1 )) != semicOK )
4025	{
4026	WerrorS( "first argument is not a spectrum:" );
4027	list_error( state );
4028	}
4029	else if( (state=list_is_spectrum( l2 )) != semicOK )
4030	{
4031	WerrorS( "second argument is not a spectrum:" );
4032	list_error( state );
4033	}
4034	else
4035	{
4036	spectrum s1= spectrumFromList ( l1 );
4037	spectrum s2= spectrumFromList ( l2 );
4038	spectrum sum( s1+s2 );
4039
4040	result->rtyp = LIST_CMD;
4041	result->data = (char*)(getList(sum));
4042	}
4043
4044	return (state!=semicOK);
4045	}
4046
4047	// ----------------------------------------------------------------------------
4048	// this procedure is called from the interpreter
4049	// ----------------------------------------------------------------------------
4050	// first = list of spectrum numbers
4051	// second = integer
4052	// result = the multiple of the first list by the second factor
4053	// ----------------------------------------------------------------------------
4054
4055	BOOLEAN spmulProc( leftv result,leftv first,leftv second )
4056	{
4057	semicState state;
4058
4059	// -----------------
4060	// check arguments
4061	// -----------------
4062
4063	lists l = (lists)first->Data( );
4064	int k = (int)(long)second->Data( );
4065
4066	if( (state=list_is_spectrum( l ))!=semicOK )
4067	{
4068	WerrorS( "first argument is not a spectrum" );
4069	list_error( state );
4070	}
4071	else if( k < 0 )
4072	{
4073	WerrorS( "second argument should be positive" );
4074	state = semicMulNegative;
4075	}
4076	else
4077	{
4078	spectrum s= spectrumFromList( l );
4079	spectrum product( k*s );
4080
4081	result->rtyp = LIST_CMD;
4082	result->data = (char*)getList(product);
4083	}
4084
4085	return (state!=semicOK);
4086	}
4087
4088	// ----------------------------------------------------------------------------
4089	// this procedure is called from the interpreter
4090	// ----------------------------------------------------------------------------
4091	// first = list of spectrum numbers
4092	// second = list of spectrum numbers
4093	// result = semicontinuity index
4094	// ----------------------------------------------------------------------------
4095
4096	BOOLEAN semicProc3 ( leftv res,leftv u,leftv v,leftv w )
4097	{
4098	semicState state;
4099	BOOLEAN qh=(((int)(long)w->Data())==1);
4100
4101	// -----------------
4102	// check arguments
4103	// -----------------
4104
4105	lists l1 = (lists)u->Data( );
4106	lists l2 = (lists)v->Data( );
4107
4108	if( (state=list_is_spectrum( l1 ))!=semicOK )
4109	{
4110	WerrorS( "first argument is not a spectrum" );
4111	list_error( state );
4112	}
4113	else if( (state=list_is_spectrum( l2 ))!=semicOK )
4114	{
4115	WerrorS( "second argument is not a spectrum" );
4116	list_error( state );
4117	}
4118	else
4119	{
4120	spectrum s1= spectrumFromList( l1 );
4121	spectrum s2= spectrumFromList( l2 );
4122
4123	res->rtyp = INT_CMD;
4124	if (qh)
4125	res->data = (void*)(s1.mult_spectrumh( s2 ));
4126	else
4127	res->data = (void*)(s1.mult_spectrum( s2 ));
4128	}
4129
4130	// -----------------
4131	// check status
4132	// -----------------
4133
4134	return (state!=semicOK);
4135	}
4136	BOOLEAN semicProc ( leftv res,leftv u,leftv v )
4137	{
4138	sleftv tmp;
4139	memset(&tmp,0,sizeof(tmp));
4140	tmp.rtyp=INT_CMD;
4141	/* tmp.data = (void )0; -- done by memset /
4142
4143	return semicProc3(res,u,v,&tmp);
4144	}
4145
4146	#endif
4147
4148	//from mpr_inout.cc
4149	extern void nPrint(number n);
4150
4151	BOOLEAN loNewtonP( leftv res, leftv arg1 )
4152	{
4153	res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4154	return FALSE;
4155	}
4156
4157	BOOLEAN loSimplex( leftv res, leftv args )
4158	{
4159	if ( !(rField_is_long_R(currRing)) )
4160	{
4161	WerrorS("Ground field not implemented!");
4162	return TRUE;
4163	}
4164
4165	simplex * LP;
4166	matrix m;
4167
4168	leftv v= args;
4169	if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4170	return TRUE;
4171	else
4172	m= (matrix)(v->CopyD());
4173
4174	LP = new simplex(MATROWS(m),MATCOLS(m));
4175	LP->mapFromMatrix(m);
4176
4177	v= v->next;
4178	if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4179	return TRUE;
4180	else
4181	LP->m= (int)(long)(v->Data());
4182
4183	v= v->next;
4184	if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4185	return TRUE;
4186	else
4187	LP->n= (int)(long)(v->Data());
4188
4189	v= v->next;
4190	if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4191	return TRUE;
4192	else
4193	LP->m1= (int)(long)(v->Data());
4194
4195	v= v->next;
4196	if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4197	return TRUE;
4198	else
4199	LP->m2= (int)(long)(v->Data());
4200
4201	v= v->next;
4202	if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4203	return TRUE;
4204	else
4205	LP->m3= (int)(long)(v->Data());
4206
4207	#ifdef mprDEBUG_PROT
4208	Print("m (constraints) %d\n",LP->m);
4209	Print("n (columns) %d\n",LP->n);
4210	Print("m1 (<=) %d\n",LP->m1);
4211	Print("m2 (>=) %d\n",LP->m2);
4212	Print("m3 (==) %d\n",LP->m3);
4213	#endif
4214
4215	LP->compute();
4216
4217	lists lres= (lists)omAlloc( sizeof(slists) );
4218	lres->Init( 6 );
4219
4220	lres->m[0].rtyp= MATRIX_CMD; // output matrix
4221	lres->m[0].data=(void*)LP->mapToMatrix(m);
4222
4223	lres->m[1].rtyp= INT_CMD; // found a solution?
4224	lres->m[1].data=(void*)LP->icase;
4225
4226	lres->m[2].rtyp= INTVEC_CMD;
4227	lres->m[2].data=(void*)LP->posvToIV();
4228
4229	lres->m[3].rtyp= INTVEC_CMD;
4230	lres->m[3].data=(void*)LP->zrovToIV();
4231
4232	lres->m[4].rtyp= INT_CMD;
4233	lres->m[4].data=(void*)LP->m;
4234
4235	lres->m[5].rtyp= INT_CMD;
4236	lres->m[5].data=(void*)LP->n;
4237
4238	res->data= (void*)lres;
4239
4240	return FALSE;
4241	}
4242
4243	BOOLEAN nuMPResMat( leftv res, leftv arg1, leftv arg2 )
4244	{
4245	ideal gls = (ideal)(arg1->Data());
4246	int imtype= (int)(long)arg2->Data();
4247
4248	uResultant::resMatType mtype= determineMType( imtype );
4249
4250	// check input ideal ( = polynomial system )
4251	if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4252	{
4253	return TRUE;
4254	}
4255
4256	uResultant *resMat= new uResultant( gls, mtype, false );
4257	if (resMat!=NULL)
4258	{
4259	res->rtyp = MODUL_CMD;
4260	res->data= (void*)resMat->accessResMat()->getMatrix();
4261	if (!errorreported) delete resMat;
4262	}
4263	return errorreported;
4264	}
4265
4266	BOOLEAN nuLagSolve( leftv res, leftv arg1, leftv arg2, leftv arg3 )
4267	{
4268
4269	poly gls;
4270	gls= (poly)(arg1->Data());
4271	int howclean= (int)(long)arg3->Data();
4272
4273	if ( !(rField_is_R(currRing) \|\|
4274	rField_is_Q(currRing) \|\|
4275	rField_is_long_R(currRing) \|\|
4276	rField_is_long_C(currRing)) )
4277	{
4278	WerrorS("Ground field not implemented!");
4279	return TRUE;
4280	}
4281
4282	if ( !(rField_is_R(currRing) \|\| rField_is_long_R(currRing) \|\| \
4283	rField_is_long_C(currRing)) )
4284	{
4285	unsigned long int ii = (unsigned long int)arg2->Data();
4286	setGMPFloatDigits( ii, ii );
4287	}
4288
4289	if ( gls == NULL \|\| pIsConstant( gls ) )
4290	{
4291	WerrorS("Input polynomial is constant!");
4292	return TRUE;
4293	}
4294
4295	int ldummy;
4296	int deg= currRing->pLDeg( gls, &ldummy, currRing );
4297	// int deg= pDeg( gls );
4298	// int len= pLength( gls );
4299	int i,vpos=0;
4300	poly piter;
4301	lists elist;
4302	lists rlist;
4303
4304	elist= (lists)omAlloc( sizeof(slists) );
4305	elist->Init( 0 );
4306
4307	if ( rVar(currRing) > 1 )
4308	{
4309	piter= gls;
4310	for ( i= 1; i <= rVar(currRing); i++ )
4311	if ( pGetExp( piter, i ) )
4312	{
4313	vpos= i;
4314	break;
4315	}
4316	while ( piter )
4317	{
4318	for ( i= 1; i <= rVar(currRing); i++ )
4319	if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4320	{
4321	WerrorS("The input polynomial must be univariate!");
4322	return TRUE;
4323	}
4324	pIter( piter );
4325	}
4326	}
4327
4328	rootContainer * roots= new rootContainer();
4329	number * pcoeffs= (number )omAlloc( (deg+1) sizeof( number ) );
4330	piter= gls;
4331	for ( i= deg; i >= 0; i-- )
4332	{
4333	//if ( piter ) Print("deg %d, pDeg(piter) %d\n",i,pTotaldegree(piter));
4334	if ( piter && pTotaldegree(piter) == i )
4335	{
4336	pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4337	//nPrint( pcoeffs[i] );PrintS(" ");
4338	pIter( piter );
4339	}
4340	else
4341	{
4342	pcoeffs[i]= nInit(0);
4343	}
4344	}
4345
4346	#ifdef mprDEBUG_PROT
4347	for (i=deg; i >= 0; i--)
4348	{
4349	nPrint( pcoeffs[i] );PrintS(" ");
4350	}
4351	PrintLn();
4352	#endif
4353
4354	roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4355	roots->solver( howclean );
4356
4357	int elem= roots->getAnzRoots();
4358	char *dummy;
4359	int j;
4360
4361	rlist= (lists)omAlloc( sizeof(slists) );
4362	rlist->Init( elem );
4363
4364	if (rField_is_long_C(currRing))
4365	{
4366	for ( j= 0; j < elem; j++ )
4367	{
4368	rlist->m[j].rtyp=NUMBER_CMD;
4369	rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4370	//rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4371	}
4372	}
4373	else
4374	{
4375	for ( j= 0; j < elem; j++ )
4376	{
4377	dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4378	rlist->m[j].rtyp=STRING_CMD;
4379	rlist->m[j].data=(void *)dummy;
4380	}
4381	}
4382
4383	elist->Clean();
4384	//omFreeSize( (ADDRESS) elist, sizeof(slists) );
4385
4386	// this is (via fillContainer) the same data as in root
4387	//for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4388	//omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4389
4390	delete roots;
4391
4392	res->rtyp= LIST_CMD;
4393	res->data= (void*)rlist;
4394
4395	return FALSE;
4396	}
4397
4398	BOOLEAN nuVanderSys( leftv res, leftv arg1, leftv arg2, leftv arg3)
4399	{
4400	int i;
4401	ideal p,w;
4402	p= (ideal)arg1->Data();
4403	w= (ideal)arg2->Data();
4404
4405	// w[0] = f(p^0)
4406	// w[1] = f(p^1)
4407	// ...
4408	// p can be a vector of numbers (multivariate polynom)
4409	// or one number (univariate polynom)
4410	// tdg = deg(f)
4411
4412	int n= IDELEMS( p );
4413	int m= IDELEMS( w );
4414	int tdg= (int)(long)arg3->Data();
4415
4416	res->data= (void*)NULL;
4417
4418	// check the input
4419	if ( tdg < 1 )
4420	{
4421	WerrorS("Last input parameter must be > 0!");
4422	return TRUE;
4423	}
4424	if ( n != rVar(currRing) )
4425	{
4426	Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4427	return TRUE;
4428	}
4429	if ( m != (int)pow((double)tdg+1,(double)n) )
4430	{
4431	Werror("Size of second input ideal must be equal to %d!",
4432	(int)pow((double)tdg+1,(double)n));
4433	return TRUE;
4434	}
4435	if ( !(rField_is_Q(currRing) /* \|\|
4436	rField_is_R() \|\| rField_is_long_R() \|\|
4437	rField_is_long_C()*/ ) )
4438	{
4439	WerrorS("Ground field not implemented!");
4440	return TRUE;
4441	}
4442
4443	number tmp;
4444	number pevpoint= (number )omAlloc( n * sizeof( number ) );
4445	for ( i= 0; i < n; i++ )
4446	{
4447	pevpoint[i]=nInit(0);
4448	if ( (p->m)[i] )
4449	{
4450	tmp = pGetCoeff( (p->m)[i] );
4451	if ( nIsZero(tmp) \|\| nIsOne(tmp) \|\| nIsMOne(tmp) )
4452	{
4453	omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4454	WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4455	return TRUE;
4456	}
4457	} else tmp= NULL;
4458	if ( !nIsZero(tmp) )
4459	{
4460	if ( !pIsConstant((p->m)[i]))
4461	{
4462	omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4463	WerrorS("Elements of first input ideal must be numbers!");
4464	return TRUE;
4465	}
4466	pevpoint[i]= nCopy( tmp );
4467	}
4468	}
4469
4470	number wresults= (number )omAlloc( m * sizeof( number ) );
4471	for ( i= 0; i < m; i++ )
4472	{
4473	wresults[i]= nInit(0);
4474	if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4475	{
4476	if ( !pIsConstant((w->m)[i]))
4477	{
4478	omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4479	omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4480	WerrorS("Elements of second input ideal must be numbers!");
4481	return TRUE;
4482	}
4483	wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4484	}
4485	}
4486
4487	vandermonde vm( m, n, tdg, pevpoint, FALSE );
4488	number *ncpoly= vm.interpolateDense( wresults );
4489	// do not free ncpoly[]!!
4490	poly rpoly= vm.numvec2poly( ncpoly );
4491
4492	omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4493	omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4494
4495	res->data= (void*)rpoly;
4496	return FALSE;
4497	}
4498
4499	BOOLEAN nuUResSolve( leftv res, leftv args )
4500	{
4501	leftv v= args;
4502
4503	ideal gls;
4504	int imtype;
4505	int howclean;
4506
4507	// get ideal
4508	if ( v->Typ() != IDEAL_CMD )
4509	return TRUE;
4510	else gls= (ideal)(v->Data());
4511	v= v->next;
4512
4513	// get resultant matrix type to use (0,1)
4514	if ( v->Typ() != INT_CMD )
4515	return TRUE;
4516	else imtype= (int)(long)v->Data();
4517	v= v->next;
4518
4519	if (imtype==0)
4520	{
4521	ideal test_id=idInit(1,1);
4522	int j;
4523	for(j=IDELEMS(gls)-1;j>=0;j--)
4524	{
4525	if (gls->m[j]!=NULL)
4526	{
4527	test_id->m[0]=gls->m[j];
4528	intvec *dummy_w=id_QHomWeight(test_id, currRing);
4529	if (dummy_w!=NULL)
4530	{
4531	WerrorS("Newton polytope not of expected dimension");
4532	delete dummy_w;
4533	return TRUE;
4534	}
4535	}
4536	}
4537	}
4538
4539	// get and set precision in digits ( > 0 )
4540	if ( v->Typ() != INT_CMD )
4541	return TRUE;
4542	else if ( !(rField_is_R(currRing) \|\| rField_is_long_R(currRing) \|\| \
4543	rField_is_long_C(currRing)) )
4544	{
4545	unsigned long int ii=(unsigned long int)v->Data();
4546	setGMPFloatDigits( ii, ii );
4547	}
4548	v= v->next;
4549
4550	// get interpolation steps (0,1,2)
4551	if ( v->Typ() != INT_CMD )
4552	return TRUE;
4553	else howclean= (int)(long)v->Data();
4554
4555	uResultant::resMatType mtype= determineMType( imtype );
4556	int i,count;
4557	lists listofroots= NULL;
4558	number smv= NULL;
4559	BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4560
4561	//emptylist= (lists)omAlloc( sizeof(slists) );
4562	//emptylist->Init( 0 );
4563
4564	//res->rtyp = LIST_CMD;
4565	//res->data= (void *)emptylist;
4566
4567	// check input ideal ( = polynomial system )
4568	if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4569	{
4570	return TRUE;
4571	}
4572
4573	uResultant * ures;
4574	rootContainer ** iproots;
4575	rootContainer ** muiproots;
4576	rootArranger * arranger;
4577
4578	// main task 1: setup of resultant matrix
4579	ures= new uResultant( gls, mtype );
4580	if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4581	{
4582	WerrorS("Error occurred during matrix setup!");
4583	return TRUE;
4584	}
4585
4586	// if dense resultant, check if minor nonsingular
4587	if ( mtype == uResultant::denseResMat )
4588	{
4589	smv= ures->accessResMat()->getSubDet();
4590	#ifdef mprDEBUG_PROT
4591	PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4592	#endif
4593	if ( nIsZero(smv) )
4594	{
4595	WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4596	return TRUE;
4597	}
4598	}
4599
4600	// main task 2: Interpolate specialized resultant polynomials
4601	if ( interpolate_det )
4602	iproots= ures->interpolateDenseSP( false, smv );
4603	else
4604	iproots= ures->specializeInU( false, smv );
4605
4606	// main task 3: Interpolate specialized resultant polynomials
4607	if ( interpolate_det )
4608	muiproots= ures->interpolateDenseSP( true, smv );
4609	else
4610	muiproots= ures->specializeInU( true, smv );
4611
4612	#ifdef mprDEBUG_PROT
4613	int c= iproots[0]->getAnzElems();
4614	for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4615	c= muiproots[0]->getAnzElems();
4616	for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4617	#endif
4618
4619	// main task 4: Compute roots of specialized polys and match them up
4620	arranger= new rootArranger( iproots, muiproots, howclean );
4621	arranger->solve_all();
4622
4623	// get list of roots
4624	if ( arranger->success() )
4625	{
4626	arranger->arrange();
4627	listofroots= listOfRoots(arranger, gmp_output_digits );
4628	}
4629	else
4630	{
4631	WerrorS("Solver was unable to find any roots!");
4632	return TRUE;
4633	}
4634
4635	// free everything
4636	count= iproots[0]->getAnzElems();
4637	for (i=0; i < count; i++) delete iproots[i];
4638	omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4639	count= muiproots[0]->getAnzElems();
4640	for (i=0; i < count; i++) delete muiproots[i];
4641	omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4642
4643	delete ures;
4644	delete arranger;
4645	nDelete( &smv );
4646
4647	res->data= (void *)listofroots;
4648
4649	//emptylist->Clean();
4650	// omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4651
4652	return FALSE;
4653	}
4654
4655	// from mpr_numeric.cc
4656	lists listOfRoots( rootArranger* self, const unsigned int oprec )
4657	{
4658	int i,j;
4659	int count= self->roots[0]->getAnzRoots(); // number of roots
4660	int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4661
4662	lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4663
4664	if ( self->found_roots )
4665	{
4666	listofroots->Init( count );
4667
4668	for (i=0; i < count; i++)
4669	{
4670	lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4671	onepoint->Init(elem);
4672	for ( j= 0; j < elem; j++ )
4673	{
4674	if ( !rField_is_long_C(currRing) )
4675	{
4676	onepoint->m[j].rtyp=STRING_CMD;
4677	onepoint->m[j].data=(void )complexToStr((self->roots[j])[i],oprec, currRing->cf);
4678	}
4679	else
4680	{
4681	onepoint->m[j].rtyp=NUMBER_CMD;
4682	onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
4683	}
4684	onepoint->m[j].next= NULL;
4685	onepoint->m[j].name= NULL;
4686	}
4687	listofroots->m[i].rtyp=LIST_CMD;
4688	listofroots->m[i].data=(void *)onepoint;
4689	listofroots->m[j].next= NULL;
4690	listofroots->m[j].name= NULL;
4691	}
4692
4693	}
4694	else
4695	{
4696	listofroots->Init( 0 );
4697	}
4698
4699	return listofroots;
4700	}
4701
4702	// from ring.cc
4703	void rSetHdl(idhdl h)
4704	{
4705	ring rg = NULL;
4706	if (h!=NULL)
4707	{
4708	// Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
4709	rg = IDRING(h);
4710	if (rg==NULL) return; //id <>NULL, ring==NULL
4711	omCheckAddrSize((ADDRESS)h,sizeof(idrec));
4712	if (IDID(h)) // OB: ????
4713	omCheckAddr((ADDRESS)IDID(h));
4714	rTest(rg);
4715	}
4716
4717	// clean up history
4718	if (sLastPrinted.RingDependend())
4719	{
4720	sLastPrinted.CleanUp();
4721	memset(&sLastPrinted,0,sizeof(sleftv));
4722	}
4723
4724	// test for valid "currRing":
4725	if ((rg!=NULL) && (rg->idroot==NULL))
4726	{
4727	ring old=rg;
4728	rg=rAssure_HasComp(rg);
4729	if (old!=rg)
4730	{
4731	rKill(old);
4732	IDRING(h)=rg;
4733	}
4734	}
4735	/------------ change the global ring -----------------------/
4736	rChangeCurrRing(rg);
4737	currRingHdl = h;
4738	}
4739
4740	BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
4741	{
4742	int last = 0, o=0, n = 1, i=0, typ = 1, j;
4743	sleftv *sl = ord;
4744
4745	// determine nBlocks
4746	while (sl!=NULL)
4747	{
4748	intvec iv = (intvec )(sl->data);
4749	if (((iv)[1]==ringorder_c)\|\|((iv)[1]==ringorder_C))
4750	i++;
4751	else if ((*iv)[1]==ringorder_L)
4752	{
4753	R->bitmask=(*iv)[2];
4754	n--;
4755	}
4756	else if (((*iv)[1]!=ringorder_a)
4757	&& ((*iv)[1]!=ringorder_a64)
4758	&& ((*iv)[1]!=ringorder_am))
4759	o++;
4760	n++;
4761	sl=sl->next;
4762	}
4763	// check whether at least one real ordering
4764	if (o==0)
4765	{
4766	WerrorS("invalid combination of orderings");
4767	return TRUE;
4768	}
4769	// if no c/C ordering is given, increment n
4770	if (i==0) n++;
4771	else if (i != 1)
4772	{
4773	// throw error if more than one is given
4774	WerrorS("more than one ordering c/C specified");
4775	return TRUE;
4776	}
4777
4778	// initialize fields of R
4779	R->order=(int )omAlloc0(nsizeof(int));
4780	R->block0=(int )omAlloc0(nsizeof(int));
4781	R->block1=(int )omAlloc0(nsizeof(int));
4782	R->wvhdl=(int*)omAlloc0(nsizeof(int_ptr));
4783
4784	int weights=(int)omAlloc0((R->N+1)*sizeof(int));
4785
4786	// init order, so that rBlocks works correctly
4787	for (j=0; j < n-1; j++)
4788	R->order[j] = (int) ringorder_unspec;
4789	// set last _C order, if no c/C order was given
4790	if (i == 0) R->order[n-2] = ringorder_C;
4791
4792	/* init orders */
4793	sl=ord;
4794	n=-1;
4795	while (sl!=NULL)
4796	{
4797	intvec *iv;
4798	iv = (intvec *)(sl->data);
4799	if ((*iv)[1]!=ringorder_L)
4800	{
4801	n++;
4802
4803	/* the format of an ordering:
4804	* iv[0]: factor
4805	* iv[1]: ordering
4806	* iv[2..end]: weights
4807	*/
4808	R->order[n] = (*iv)[1];
4809	typ=1;
4810	switch ((*iv)[1])
4811	{
4812	case ringorder_ws:
4813	case ringorder_Ws:
4814	typ=-1;
4815	case ringorder_wp:
4816	case ringorder_Wp:
4817	R->wvhdl[n]=(int)omAlloc((iv->length()-1)sizeof(int));
4818	R->block0[n] = last+1;
4819	for (i=2; i<iv->length(); i++)
4820	{
4821	R->wvhdl[n][i-2] = (*iv)[i];
4822	last++;
4823	if (weights[last]==0) weights[last]=(iv)[i]typ;
4824	}
4825	R->block1[n] = last;
4826	break;
4827	case ringorder_ls:
4828	case ringorder_ds:
4829	case ringorder_Ds:
4830	case ringorder_rs:
4831	typ=-1;
4832	case ringorder_lp:
4833	case ringorder_dp:
4834	case ringorder_Dp:
4835	case ringorder_rp:
4836	R->block0[n] = last+1;
4837	if (iv->length() == 3) last+=(*iv)[2];
4838	else last += (*iv)[0];
4839	R->block1[n] = last;
4840	//if ((R->block0[n]>R->block1[n])
4841	//\|\| (R->block1[n]>rVar(R)))
4842	//{
4843	// R->block1[n]=rVar(R);
4844	// //WerrorS("ordering larger than number of variables");
4845	// break;
4846	//}
4847	if (rCheckIV(iv)) return TRUE;
4848	for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
4849	{
4850	if (weights[i]==0) weights[i]=typ;
4851	}
4852	break;
4853
4854	case ringorder_s: // no 'rank' params!
4855	{
4856
4857	if(iv->length() > 3)
4858	return TRUE;
4859
4860	if(iv->length() == 3)
4861	{
4862	const int s = (*iv)[2];
4863	R->block0[n] = s;
4864	R->block1[n] = s;
4865	}
4866	break;
4867	}
4868	case ringorder_IS:
4869	{
4870	if(iv->length() != 3) return TRUE;
4871
4872	const int s = (*iv)[2];
4873
4874	if( 1 < s \|\| s < -1 ) return TRUE;
4875
4876	R->block0[n] = s;
4877	R->block1[n] = s;
4878	break;
4879	}
4880	case ringorder_S:
4881	case ringorder_c:
4882	case ringorder_C:
4883	{
4884	if (rCheckIV(iv)) return TRUE;
4885	break;
4886	}
4887	case ringorder_aa:
4888	case ringorder_a:
4889	{
4890	R->block0[n] = last+1;
4891	R->block1[n] = si_min(last+iv->length()-2 , rVar(R));
4892	R->wvhdl[n] = (int)omAlloc((iv->length()-1)sizeof(int));
4893	for (i=2; i<iv->length(); i++)
4894	{
4895	R->wvhdl[n][i-2]=(*iv)[i];
4896	last++;
4897	if (weights[last]==0) weights[last]=(iv)[i]typ;
4898	}
4899	last=R->block0[n]-1;
4900	break;
4901	}
4902	case ringorder_am:
4903	{
4904	R->block0[n] = last+1;
4905	R->block1[n] = si_min(last+iv->length()-2 , rVar(R));
4906	R->wvhdl[n] = (int)omAlloc(iv->length()sizeof(int));
4907	if (R->block1[n]- R->block0[n]+2>=iv->length())
4908	WarnS("missing module weights");
4909	for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
4910	{
4911	R->wvhdl[n][i-2]=(*iv)[i];
4912	last++;
4913	if (weights[last]==0) weights[last]=(iv)[i]typ;
4914	}
4915	R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
4916	for (; i<iv->length(); i++)
4917	{
4918	R->wvhdl[n][i-1]=(*iv)[i];
4919	}
4920	last=R->block0[n]-1;
4921	break;
4922	}
4923	case ringorder_a64:
4924	{
4925	R->block0[n] = last+1;
4926	R->block1[n] = si_min(last+iv->length()-2 , rVar(R));
4927	R->wvhdl[n] = (int)omAlloc((iv->length()-1)sizeof(int64));
4928	int64 w=(int64 )R->wvhdl[n];
4929	for (i=2; i<iv->length(); i++)
4930	{
4931	w[i-2]=(*iv)[i];
4932	last++;
4933	if (weights[last]==0) weights[last]=(iv)[i]typ;
4934	}
4935	last=R->block0[n]-1;
4936	break;
4937	}
4938	case ringorder_M:
4939	{
4940	int Mtyp=rTypeOfMatrixOrder(iv);
4941	if (Mtyp==0) return TRUE;
4942	if (Mtyp==-1) typ = -1;
4943
4944	R->wvhdl[n] =( int )omAlloc((iv->length()-1)sizeof(int));
4945	for (i=2; i<iv->length();i++)
4946	R->wvhdl[n][i-2]=(*iv)[i];
4947
4948	R->block0[n] = last+1;
4949	last += (int)sqrt((double)(iv->length()-2));
4950	R->block1[n] = last;
4951	for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
4952	{
4953	if (weights[i]==0) weights[i]=typ;
4954	}
4955	break;
4956	}
4957
4958	case ringorder_no:
4959	R->order[n] = ringorder_unspec;
4960	return TRUE;
4961
4962	default:
4963	Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
4964	R->order[n] = ringorder_unspec;
4965	return TRUE;
4966	}
4967	}
4968	sl=sl->next;
4969	}
4970
4971	// check for complete coverage
4972	while ( n >= 0 && (
4973	(R->order[n]==ringorder_c)
4974	\|\| (R->order[n]==ringorder_C)
4975	\|\| (R->order[n]==ringorder_s)
4976	\|\| (R->order[n]==ringorder_S)
4977	\|\| (R->order[n]==ringorder_IS)
4978	)) n--;
4979
4980	assume( n >= 0 );
4981
4982	if (R->block1[n] != R->N)
4983	{
4984	if (((R->order[n]==ringorder_dp) \|\|
4985	(R->order[n]==ringorder_ds) \|\|
4986	(R->order[n]==ringorder_Dp) \|\|
4987	(R->order[n]==ringorder_Ds) \|\|
4988	(R->order[n]==ringorder_rp) \|\|
4989	(R->order[n]==ringorder_rs) \|\|
4990	(R->order[n]==ringorder_lp) \|\|
4991	(R->order[n]==ringorder_ls))
4992	&&
4993	R->block0[n] <= R->N)
4994	{
4995	R->block1[n] = R->N;
4996	}
4997	else
4998	{
4999	Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5000	R->N,R->block1[n]);
5001	return TRUE;
5002	}
5003	}
5004	// find OrdSgn:
5005	R->OrdSgn = 1;
5006	for(i=1;i<=R->N;i++)
5007	{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
5008	omFree(weights);
5009	return FALSE;
5010	}
5011
5012	BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p)
5013	{
5014
5015	while(sl!=NULL)
5016	{
5017	if (sl->Name() == sNoName)
5018	{
5019	if (sl->Typ()==POLY_CMD)
5020	{
5021	sleftv s_sl;
5022	iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5023	if (s_sl.Name() != sNoName)
5024	*p = omStrDup(s_sl.Name());
5025	else
5026	*p = NULL;
5027	sl->next = s_sl.next;
5028	s_sl.next = NULL;
5029	s_sl.CleanUp();
5030	if (*p == NULL) return TRUE;
5031	}
5032	else
5033	return TRUE;
5034	}
5035	else
5036	*p = omStrDup(sl->Name());
5037	p++;
5038	sl=sl->next;
5039	}
5040	return FALSE;
5041	}
5042
5043	const short MAX_SHORT = 32767; // (1 << (sizeof(short)*8)) - 1;
5044
5045	////////////////////
5046	//
5047	// rInit itself:
5048	//
5049	// INPUT: s: name, pn: ch & parameter (names), rv: variable (names)
5050	// ord: ordering
5051	// RETURN: currRingHdl on success
5052	// NULL on error
5053	// NOTE: * makes new ring to current ring, on success
5054	// * considers input sleftv's as read-only
5055	//idhdl rInit(char s, sleftv pn, sleftv* rv, sleftv* ord)
5056	ring rInit(sleftv* pn, sleftv* rv, sleftv* ord)
5057	{
5058	#ifdef HAVE_RINGS
5059	//unsigned int ringtype = 0;
5060	int_number modBase = NULL;
5061	unsigned int modExponent = 1;
5062	#endif
5063	int float_len=0;
5064	int float_len2=0;
5065	ring R = NULL;
5066	//BOOLEAN ffChar=FALSE;
5067
5068	/* ch -------------------------------------------------------*/
5069	// get ch of ground field
5070
5071	// allocated ring
5072	R = (ring) omAlloc0Bin(sip_sring_bin);
5073
5074	coeffs cf = NULL;
5075
5076	assume( pn != NULL );
5077	const int P = pn->listLength();
5078
5079	if (pn->Typ()==INT_CMD)
5080	{
5081	int ch = (int)(long)pn->Data();
5082
5083	/* parameter? -------------------------------------------------------*/
5084	pn = pn->next;
5085
5086	if (pn == NULL) // no params!?
5087	{
5088	if (ch!=0)
5089	{
5090	ch=IsPrime(ch);
5091	cf = nInitChar(n_Zp, (void*)(long)ch);
5092	}
5093	else
5094	cf = nInitChar(n_Q, (void*)(long)ch);
5095	}
5096	else
5097	{
5098	const int pars = pn->listLength();
5099
5100	assume( pars > 0 );
5101
5102	// predefined finite field: (p^k, a)
5103	if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5104	{
5105	GFInfo param;
5106
5107	param.GFChar = ch;
5108	param.GFDegree = 1;
5109	param.GFPar_name = pn->name;
5110
5111	cf = nInitChar(n_GF, &param);
5112	}
5113	else // (0/p, a, b, ..., z)
5114	{
5115	assume( (ch == 0) \|\| (ch==IsPrime(ch)) );
5116
5117	// if ((pars > 1) && (ffChar))
5118	// {
5119	// WerrorS("too many parameters");
5120	// goto rInitError;
5121	// }
5122
5123	char names = (char)omAlloc0(pars * sizeof(char_ptr));
5124
5125	if (rSleftvList2StringArray(pn, names))
5126	{
5127	WerrorS("parameter expected");
5128	goto rInitError;
5129	}
5130
5131	TransExtInfo extParam;
5132
5133	extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5134
5135	cf = nInitChar(n_transExt, &extParam);
5136	}
5137	}
5138
5139	// if (cf==NULL) goto rInitError;
5140	assume( cf != NULL );
5141	}
5142	else if ((pn->name != NULL)
5143	&& ((strcmp(pn->name,"real")==0) \|\| (strcmp(pn->name,"complex")==0)))
5144	{
5145	BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5146	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5147	{
5148	float_len=(int)(long)pn->next->Data();
5149	float_len2=float_len;
5150	pn=pn->next;
5151	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5152	{
5153	float_len2=(int)(long)pn->next->Data();
5154	pn=pn->next;
5155	}
5156	}
5157	assume( float_len <= float_len2 );
5158
5159	if (!complex_flag)
5160	complex_flag= pn->next != NULL;
5161	if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5162	cf=nInitChar(n_R, NULL);
5163	else // longR or longC?
5164	{
5165	LongComplexInfo param;
5166
5167	param.float_len = si_min (float_len, 32767);
5168	param.float_len2 = si_min (float_len2, 32767);
5169
5170	// set the parameter name
5171	if (complex_flag)
5172	{
5173	if (param.float_len < SHORT_REAL_LENGTH)
5174	{
5175	param.float_len= SHORT_REAL_LENGTH;
5176	param.float_len2= SHORT_REAL_LENGTH;
5177	}
5178	if (pn->next == NULL)
5179	param.par_name=(const char*)"i"; //default to i
5180	else
5181	param.par_name = (const char*)pn->next->name;
5182	}
5183
5184	cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5185	}
5186	assume( cf != NULL );
5187	}
5188	#ifdef HAVE_RINGS
5189	else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5190	{
5191	modBase = (int_number) omAlloc(sizeof(mpz_t));
5192	mpz_init_set_si(modBase, 0);
5193	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5194	{
5195	mpz_set_ui(modBase, (int)(long) pn->next->Data());
5196	pn=pn->next;
5197	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5198	{
5199	modExponent = (long) pn->next->Data();
5200	pn=pn->next;
5201	}
5202	while ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5203	{
5204	mpz_mul_ui(modBase, modBase, (int)(long) pn->next->Data());
5205	pn=pn->next;
5206	}
5207	}
5208	else
5209	cf=nInitChar(n_Z,NULL);
5210
5211	if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5212	{
5213	Werror("Wrong ground ring specification (module is 1)");
5214	goto rInitError;
5215	}
5216	if (modExponent < 1)
5217	{
5218	Werror("Wrong ground ring specification (exponent smaller than 1");
5219	goto rInitError;
5220	}
5221	// module is 0 ---> integers ringtype = 4;
5222	// we have an exponent
5223	if (modExponent > 1 && cf == NULL)
5224	{
5225	if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(NATNUMBER)))
5226	{
5227	/* this branch should be active for modExponent = 2..32 resp. 2..64,
5228	depending on the size of a long on the respective platform */
5229	//ringtype = 1; // Use Z/2^ch
5230	cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5231	omFreeSize (modBase, sizeof (mpz_t));
5232	}
5233	else
5234	{
5235	//ringtype = 3;
5236	ZnmInfo info;
5237	info.base= modBase;
5238	info.exp= modExponent;
5239	cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5240	}
5241	}
5242	// just a module m > 1
5243	else if (cf == NULL)
5244	{
5245	//ringtype = 2;
5246	ZnmInfo info;
5247	info.base= modBase;
5248	info.exp= modExponent;
5249	cf=nInitChar(n_Zn,(void*) &info);
5250	}
5251	assume( cf != NULL );
5252	}
5253	#endif
5254	// ring NEW = OLD, (), (); where OLD is a polynomial ring...
5255	else if ((pn->Typ()==RING_CMD) && (P == 1))
5256	{
5257	TransExtInfo extParam;
5258	extParam.r = (ring)pn->Data();
5259	cf = nInitChar(n_transExt, &extParam);
5260	}
5261	else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5262	{
5263	AlgExtInfo extParam;
5264	extParam.r = (ring)pn->Data();
5265
5266	cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5267	}
5268	else
5269	{
5270	Werror("Wrong or unknown ground field specification");
5271	#ifndef NDEBUG
5272	sleftv* p = pn;
5273	while (p != NULL)
5274	{
5275	Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5276	PrintLn();
5277	p = p->next;
5278	}
5279	#endif
5280	goto rInitError;
5281	}
5282	// pn=pn->next;
5283
5284	/every entry in the new ring is initialized to 0/
5285
5286	/* characteristic -----------------------------------------------*/
5287	/* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5288	* 0 1 : Q(a,...) *names FALSE
5289	* 0 -1 : R NULL FALSE 0
5290	* 0 -1 : R NULL FALSE prec. >6
5291	* 0 -1 : C *names FALSE prec. 0..?
5292	* p p : Fp NULL FALSE
5293	* p -p : Fp(a) *names FALSE
5294	* q q : GF(q=p^n) *names TRUE
5295	*/
5296	if (cf==NULL)
5297	{
5298	const int ch=32003;
5299	Warn("Invalid ground field specification: using the default field: Z_{%d}", ch);
5300	cf=nInitChar(n_Zp, (void*)(long)ch);
5301	}
5302
5303	assume( R != NULL );
5304
5305	R->cf = cf;
5306
5307	/* names and number of variables-------------------------------------*/
5308	{
5309	int l=rv->listLength();
5310
5311	if (l>MAX_SHORT)
5312	{
5313	Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5314	goto rInitError;
5315	}
5316	R->N = l; /rv->listLength();/
5317	}
5318	R->names = (char *)omAlloc0(R->N sizeof(char_ptr));
5319	if (rSleftvList2StringArray(rv, R->names))
5320	{
5321	WerrorS("name of ring variable expected");
5322	goto rInitError;
5323	}
5324
5325	/* check names and parameters for conflicts ------------------------- */
5326	rRenameVars(R); // conflicting variables will be renamed
5327	/* ordering -------------------------------------------------------------*/
5328	if (rSleftvOrdering2Ordering(ord, R))
5329	goto rInitError;
5330
5331	// Complete the initialization
5332	if (rComplete(R,1))
5333	goto rInitError;
5334
5335	#ifdef HABE_RINGS
5336	// currently, coefficients which are ring elements require a global ordering:
5337	if (rField_is_Ring(R) && (R->OrdSgn==-1))
5338	{
5339	WerrorS("global ordering required for these coefficients");
5340	goto rInitError;
5341	}
5342	#endif
5343
5344	rTest(R);
5345
5346	// try to enter the ring into the name list
5347	// need to clean up sleftv here, before this ring can be set to
5348	// new currRing or currRing can be killed beacuse new ring has
5349	// same name
5350	if (pn != NULL) pn->CleanUp();
5351	if (rv != NULL) rv->CleanUp();
5352	if (ord != NULL) ord->CleanUp();
5353	//if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5354	// goto rInitError;
5355
5356	//memcpy(IDRING(tmp),R,sizeof(*R));
5357	// set current ring
5358	//omFreeBin(R, ip_sring_bin);
5359	//return tmp;
5360	return R;
5361
5362	// error case:
5363	rInitError:
5364	if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5365	if (pn != NULL) pn->CleanUp();
5366	if (rv != NULL) rv->CleanUp();
5367	if (ord != NULL) ord->CleanUp();
5368	return NULL;
5369	}
5370
5371	ring rSubring(ring org_ring, sleftv* rv)
5372	{
5373	ring R = rCopy0(org_ring);
5374	int perm=(int )omAlloc0((org_ring->N+1)*sizeof(int));
5375	int n = rBlocks(org_ring), i=0, j;
5376
5377	/* names and number of variables-------------------------------------*/
5378	{
5379	int l=rv->listLength();
5380	if (l>MAX_SHORT)
5381	{
5382	Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5383	goto rInitError;
5384	}
5385	R->N = l; /rv->listLength();/
5386	}
5387	omFree(R->names);
5388	R->names = (char *)omAlloc0(R->N sizeof(char_ptr));
5389	if (rSleftvList2StringArray(rv, R->names))
5390	{
5391	WerrorS("name of ring variable expected");
5392	goto rInitError;
5393	}
5394
5395	/* check names for subring in org_ring ------------------------- */
5396	{
5397	i=0;
5398
5399	for(j=0;j<R->N;j++)
5400	{
5401	for(;i<org_ring->N;i++)
5402	{
5403	if (strcmp(org_ring->names[i],R->names[j])==0)
5404	{
5405	perm[i+1]=j+1;
5406	break;
5407	}
5408	}
5409	if (i>org_ring->N)
5410	{
5411	Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5412	break;
5413	}
5414	}
5415	}
5416	//Print("perm=");
5417	//for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5418	/* ordering -------------------------------------------------------------*/
5419
5420	for(i=0;i<n;i++)
5421	{
5422	int min_var=-1;
5423	int max_var=-1;
5424	for(j=R->block0[i];j<=R->block1[i];j++)
5425	{
5426	if (perm[j]>0)
5427	{
5428	if (min_var==-1) min_var=perm[j];
5429	max_var=perm[j];
5430	}
5431	}
5432	if (min_var!=-1)
5433	{
5434	//Print("block %d: old %d..%d, now:%d..%d\n",
5435	// i,R->block0[i],R->block1[i],min_var,max_var);
5436	R->block0[i]=min_var;
5437	R->block1[i]=max_var;
5438	if (R->wvhdl[i]!=NULL)
5439	{
5440	omFree(R->wvhdl[i]);
5441	R->wvhdl[i]=(int)omAlloc0((max_var-min_var+1)sizeof(int));
5442	for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5443	{
5444	if (perm[j]>0)
5445	{
5446	R->wvhdl[i][perm[j]-R->block0[i]]=
5447	org_ring->wvhdl[i][j-org_ring->block0[i]];
5448	//Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5449	}
5450	}
5451	}
5452	}
5453	else
5454	{
5455	if(R->block0[i]>0)
5456	{
5457	//Print("skip block %d\n",i);
5458	R->order[i]=ringorder_unspec;
5459	if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5460	R->wvhdl[i]=NULL;
5461	}
5462	//else Print("keep block %d\n",i);
5463	}
5464	}
5465	i=n-1;
5466	while(i>0)
5467	{
5468	// removed unneded blocks
5469	if(R->order[i-1]==ringorder_unspec)
5470	{
5471	for(j=i;j<=n;j++)
5472	{
5473	R->order[j-1]=R->order[j];
5474	R->block0[j-1]=R->block0[j];
5475	R->block1[j-1]=R->block1[j];
5476	if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
5477	R->wvhdl[j-1]=R->wvhdl[j];
5478	}
5479	R->order[n]=ringorder_unspec;
5480	n--;
5481	}
5482	i--;
5483	}
5484	n=rBlocks(org_ring)-1;
5485	while (R->order[n]==0) n--;
5486	while (R->order[n]==ringorder_unspec) n--;
5487	if ((R->order[n]==ringorder_c) \|\| (R->order[n]==ringorder_C)) n--;
5488	if (R->block1[n] != R->N)
5489	{
5490	if (((R->order[n]==ringorder_dp) \|\|
5491	(R->order[n]==ringorder_ds) \|\|
5492	(R->order[n]==ringorder_Dp) \|\|
5493	(R->order[n]==ringorder_Ds) \|\|
5494	(R->order[n]==ringorder_rp) \|\|
5495	(R->order[n]==ringorder_rs) \|\|
5496	(R->order[n]==ringorder_lp) \|\|
5497	(R->order[n]==ringorder_ls))
5498	&&
5499	R->block0[n] <= R->N)
5500	{
5501	R->block1[n] = R->N;
5502	}
5503	else
5504	{
5505	Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
5506	R->N,R->block1[n],n);
5507	return NULL;
5508	}
5509	}
5510	omFree(perm);
5511	// find OrdSgn:
5512	R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
5513	//for(i=1;i<=R->N;i++)
5514	//{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
5515	//omFree(weights);
5516	// Complete the initialization
5517	if (rComplete(R,1))
5518	goto rInitError;
5519
5520	rTest(R);
5521
5522	if (rv != NULL) rv->CleanUp();
5523
5524	return R;
5525
5526	// error case:
5527	rInitError:
5528	if (R != NULL) rDelete(R);
5529	if (rv != NULL) rv->CleanUp();
5530	return NULL;
5531	}
5532
5533	void rKill(ring r)
5534	{
5535	if ((r->ref<=0)&&(r->order!=NULL))
5536	{
5537	#ifdef RDEBUG
5538	if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
5539	#endif
5540	if (r->qideal!=NULL)
5541	{
5542	id_Delete(&r->qideal, r);
5543	r->qideal = NULL;
5544	}
5545	int j;
5546	#ifdef USE_IILOCALRING
5547	for (j=0;j<iiRETURNEXPR_len;j++)
5548	{
5549	if (iiLocalRing[j]==r)
5550	{
5551	if (j<myynest) Warn("killing the basering for level %d",j);
5552	iiLocalRing[j]=NULL;
5553	}
5554	}
5555	#else /* USE_IILOCALRING */
5556	//#endif /* USE_IILOCALRING */
5557	{
5558	proclevel * nshdl = procstack;
5559	int lev=myynest-1;
5560
5561	for(; nshdl != NULL; nshdl = nshdl->next)
5562	{
5563	if (nshdl->cRing==r)
5564	{
5565	Warn("killing the basering for level %d",lev);
5566	nshdl->cRing=NULL;
5567	nshdl->cRingHdl=NULL;
5568	}
5569	}
5570	}
5571	#endif /* USE_IILOCALRING */
5572	// any variables depending on r ?
5573	while (r->idroot!=NULL)
5574	{
5575	killhdl2(r->idroot,&(r->idroot),r);
5576	}
5577	if (r==currRing)
5578	{
5579	// all dependend stuff is done, clean global vars:
5580	if (r->qideal!=NULL)
5581	{
5582	currQuotient=NULL;
5583	}
5584	if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
5585	if (sLastPrinted.RingDependend())
5586	{
5587	sLastPrinted.CleanUp();
5588	}
5589	if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
5590	{
5591	WerrorS("return value depends on local ring variable (export missing ?)");
5592	iiRETURNEXPR.CleanUp();
5593	}
5594	currRing=NULL;
5595	currRingHdl=NULL;
5596	}
5597
5598	/* nKillChar(r); will be called from inside of rDelete */
5599	rDelete(r);
5600	return;
5601	}
5602	r->ref--;
5603	}
5604
5605	void rKill(idhdl h)
5606	{
5607	ring r = IDRING(h);
5608	int ref=0;
5609	if (r!=NULL)
5610	{
5611	ref=r->ref;
5612	rKill(r);
5613	}
5614	if (h==currRingHdl)
5615	{
5616	if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
5617	else
5618	{
5619	currRingHdl=rFindHdl(r,currRingHdl,NULL);
5620	}
5621	}
5622	}
5623
5624	idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
5625	{
5626	//idhdl next_best=NULL;
5627	idhdl h=root;
5628	while (h!=NULL)
5629	{
5630	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
5631	&& (h!=n)
5632	&& (IDRING(h)==r)
5633	)
5634	{
5635	// if (IDLEV(h)==myynest)
5636	// return h;
5637	// if ((IDLEV(h)==0) \|\| (next_best==NULL))
5638	// next_best=h;
5639	// else if (IDLEV(next_best)<IDLEV(h))
5640	// next_best=h;
5641	return h;
5642	}
5643	h=IDNEXT(h);
5644	}
5645	//return next_best;
5646	return NULL;
5647	}
5648
5649	extern BOOLEAN jjPROC(leftv res, leftv u, leftv v);
5650	ideal kGroebner(ideal F, ideal Q)
5651	{
5652	//test\|=Sy_bit(OPT_PROT);
5653	idhdl save_ringhdl=currRingHdl;
5654	ideal resid;
5655	idhdl new_ring=NULL;
5656	if ((currRingHdl==NULL) \|\| (IDRING(currRingHdl)!=currRing))
5657	{
5658	currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
5659	new_ring=currRingHdl;
5660	IDRING(currRingHdl)=currRing;
5661	}
5662	sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
5663	idhdl h=ggetid("groebner");
5664	sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
5665	u.name=IDID(h);
5666
5667	sleftv res; memset(&res,0,sizeof(res));
5668	if(jjPROC(&res,&u,&v))
5669	{
5670	resid=kStd(F,Q,testHomog,NULL);
5671	}
5672	else
5673	{
5674	//printf("typ:%d\n",res.rtyp);
5675	resid=(ideal)(res.data);
5676	}
5677	// cleanup GROEBNERring, save_ringhdl, u,v,(res )
5678	if (new_ring!=NULL)
5679	{
5680	idhdl h=IDROOT;
5681	if (h==new_ring) IDROOT=h->next;
5682	else
5683	{
5684	while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
5685	if (h!=NULL) h->next=h->next->next;
5686	}
5687	if (h!=NULL) omFreeSize(h,sizeof(*h));
5688	}
5689	currRingHdl=save_ringhdl;
5690	u.CleanUp();
5691	v.CleanUp();
5692	return resid;
5693	}
5694
5695	static void jjINT_S_TO_ID(int n,int *e, leftv res)
5696	{
5697	if (n==0) n=1;
5698	ideal l=idInit(n,1);
5699	int i;
5700	poly p;
5701	for(i=rVar(currRing);i>0;i--)
5702	{
5703	if (e[i]>0)
5704	{
5705	n--;
5706	p=pOne();
5707	pSetExp(p,i,1);
5708	pSetm(p);
5709	l->m[n]=p;
5710	if (n==0) break;
5711	}
5712	}
5713	res->data=(char*)l;
5714	setFlag(res,FLAG_STD);
5715	omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
5716	}
5717	BOOLEAN jjVARIABLES_P(leftv res, leftv u)
5718	{
5719	int e=(int )omAlloc0((rVar(currRing)+1)*sizeof(int));
5720	int n=pGetVariables((poly)u->Data(),e);
5721	jjINT_S_TO_ID(n,e,res);
5722	return FALSE;
5723	}
5724
5725	BOOLEAN jjVARIABLES_ID(leftv res, leftv u)
5726	{
5727	int e=(int )omAlloc0((rVar(currRing)+1)*sizeof(int));
5728	ideal I=(ideal)u->Data();
5729	int i;
5730	int n=0;
5731	for(i=I->nrows*I->ncols-1;i>=0;i--)
5732	{
5733	int n0=pGetVariables(I->m[i],e);
5734	if (n0>n) n=n0;
5735	}
5736	jjINT_S_TO_ID(n,e,res);
5737	return FALSE;
5738	}
5739
5740	void paPrint(const char *n,package p)
5741	{
5742	Print("%s (",n);
5743	switch (p->language)
5744	{
5745	case LANG_SINGULAR: PrintS("S"); break;
5746	case LANG_C: PrintS("C"); break;
5747	case LANG_TOP: PrintS("T"); break;
5748	case LANG_NONE: PrintS("N"); break;
5749	default: PrintS("U");
5750	}
5751	if(p->libname!=NULL)
5752	Print(",%s", p->libname);
5753	PrintS(")");
5754	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: