Context Navigation

source: git/Singular/ipshell.cc @ 6ac003

spielwiese

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

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

Download in other formats: