Context Navigation

source: git/Singular/ipshell.cc @ f92a39

spielwiese

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

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

Download in other formats: