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