source: git/Singular/subexpr.cc @ 584b82

spielwiese
Last change on this file since 584b82 was 606608, checked in by Hans Schoenemann <hannes@…>, 22 months ago
use long: arith. nad output + tests
  • Property mode set to 100644
File size: 49.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: handling of leftv
6*/
7
8#include "kernel/mod2.h"
9#include "omalloc/omalloc.h"
10#include "misc/intvec.h"
11#include "misc/options.h"
12#include "coeffs/numbers.h"
13#include "coeffs/bigintmat.h"
14#include "coeffs/ffields.h" // nfShowMipo // minpoly printing...
15#include "polys/monomials/maps.h"
16#include "polys/matpol.h"
17#include "polys/monomials/ring.h"
18
19// #include "coeffs/longrat.h"
20
21#include "kernel/polys.h"
22#include "kernel/ideals.h"
23#include "kernel/GBEngine/kstd1.h"
24#include "kernel/GBEngine/syz.h"
25#include "kernel/oswrapper/timer.h"
26#include "Singular/tok.h"
27#include "Singular/ipid.h"
28#include "Singular/ipshell.h"
29#include "Singular/lists.h"
30#include "Singular/attrib.h"
31#include "Singular/links/silink.h"
32#include "Singular/attrib.h"
33#include "Singular/ipprint.h"
34#include "Singular/subexpr.h"
35#include "Singular/blackbox.h"
36#include "Singular/number2.h"
37
38#include <ctype.h>
39
40VAR omBin sSubexpr_bin = omGetSpecBin(sizeof(_ssubexpr));
41VAR omBin sleftv_bin = omGetSpecBin(sizeof(sleftv));
42VAR omBin procinfo_bin = omGetSpecBin(sizeof(procinfo));
43VAR omBin libstack_bin = omGetSpecBin(sizeof(libstack));
44STATIC_VAR omBin size_two_bin = omGetSpecBin(2);
45
46INST_VAR sleftv     sLastPrinted;
47#ifdef SIQ
48VAR BOOLEAN siq=FALSE;
49#endif
50
51int sleftv::listLength()
52{
53  int n = 1;
54  leftv sl = next;
55  while (sl!=NULL)
56  {
57    n++;
58    sl=sl->next;
59  }
60  return n;
61}
62
63void sleftv::Print(leftv store, int spaces)
64{
65  int  t=Typ();
66  if (errorreported) return;
67#ifdef SIQ
68  if (rtyp==COMMAND)
69  {
70    command c=(command)data;
71    char ch[2];
72    ch[0]=c->op;ch[1]='\0';
73    const char *s=ch;
74    if (c->op>127) s=iiTwoOps(c->op);
75    ::Print("##command %d(%s), %d args\n",
76      c->op, s, c->argc);
77    if (c->argc>0)
78      c->arg1.Print(NULL,spaces+2);
79    if(c->argc<4)
80    {
81      if (c->argc>1)
82        c->arg2.Print(NULL,spaces+2);
83      if (c->argc>2)
84        c->arg3.Print(NULL,spaces+2);
85    }
86    PrintS("##end");
87  }
88  else
89#endif
90  {
91    const char *n=Name();
92    char *s;
93    void *d=Data();
94    if (errorreported) return;
95
96    switch (t /*=Typ()*/)
97      {
98        case CRING_CMD:
99          crPrint((coeffs)d);
100          break;
101#ifdef SINGULAR_4_2
102        case CNUMBER_CMD:
103          n2Print((number2)d);
104          break;
105        case CPOLY_CMD:
106          p2Print((poly2)d);
107          break;
108        case CMATRIX_CMD: // like BIGINTMAT
109#endif
110        case BIGINTMAT_CMD:
111          ((bigintmat *)d)->pprint(colmax);
112          break;
113        case BUCKET_CMD:
114          {
115            sBucket_pt b=(sBucket_pt)d;
116            if ((e==NULL)
117            && (TEST_V_QRING)
118            &&(currRing->qideal!=NULL))
119            {
120              poly p=pCopy(sBucketPeek(b));
121              p=jjNormalizeQRingP(p);
122              PrintNSpaces(spaces);
123              pWrite0(p);
124              pDelete(&p);
125              break;
126            }
127            else
128              sBucketPrint(b);
129          }
130          break;
131        case UNKNOWN:
132        case DEF_CMD:
133          PrintNSpaces(spaces);
134          PrintS("`");PrintS(n);PrintS("`");
135          break;
136        case PACKAGE_CMD:
137          PrintNSpaces(spaces);
138          paPrint(n,(package)d);
139          break;
140        case LIB_CMD:
141        case NONE:
142          return;
143        case INTVEC_CMD:
144        case INTMAT_CMD:
145          ((intvec *)d)->show(t,spaces);
146          break;
147        case RING_CMD:
148        {
149          PrintNSpaces(spaces);
150          const ring r = (ring)d;
151          rWrite(r, currRing == r);
152          break;
153        }
154        case MATRIX_CMD:
155          iiWriteMatrix((matrix)d,n,2, currRing, spaces);
156          break;
157        case SMATRIX_CMD:
158        {
159          matrix m = id_Module2Matrix(id_Copy((ideal)d,currRing),currRing);
160          ipPrint_MA0(m, n);
161          id_Delete((ideal *) &m,currRing);
162          break;
163        }
164        case MODUL_CMD:
165        case IDEAL_CMD:
166          if ((TEST_V_QRING)  &&(currRing->qideal!=NULL)
167          &&(!hasFlag(this,FLAG_QRING)))
168          {
169            jjNormalizeQRingId(this);
170            d=Data();
171          }
172          // no break:
173        case MAP_CMD:
174          iiWriteMatrix((matrix)d,n,1, currRing, spaces);
175          break;
176        case POLY_CMD:
177        case VECTOR_CMD:
178          if ((e==NULL)
179          && (TEST_V_QRING)
180          &&(currRing->qideal!=NULL)
181          &&(!hasFlag(this,FLAG_QRING)))
182          {
183            setFlag(this,FLAG_QRING);
184            poly p=(poly)d;
185            p=jjNormalizeQRingP(p);
186            if (p!=(poly)d)
187            {
188              d=(void*)p;
189              if ((rtyp==POLY_CMD)||(rtyp==VECTOR_CMD)) data=d;
190              else if (rtyp==IDHDL)
191              {
192                idhdl h=(idhdl)data;
193                IDPOLY(h)=p;
194                setFlag(h,FLAG_QRING);
195              }
196            }
197          }
198          PrintNSpaces(spaces);
199          pWrite0((poly)d);
200          break;
201        case RESOLUTION_CMD:
202        {
203          syStrategy tmp=(syStrategy)d;
204          syPrint(tmp,IDID(currRingHdl));
205          break;
206        }
207        case STRING_CMD:
208          PrintNSpaces(spaces);
209          PrintS((char *)d);
210          break;
211       case INT_CMD:
212          PrintNSpaces(spaces);
213          ::Print("%ld",(long)d);
214          break;
215       case PROC_CMD:
216         {
217           procinfov pi=(procinfov)d;
218
219           PrintNSpaces(spaces);
220           PrintS("// libname  : ");
221           PrintS(piProcinfo(pi, "libname"));
222           PrintLn();
223
224           PrintNSpaces(spaces);
225           PrintS("// procname : ");
226           PrintS(piProcinfo(pi, "procname"));
227           PrintLn();
228
229           PrintNSpaces(spaces);
230           PrintS("// type     : ");
231           PrintS(piProcinfo(pi, "type"));
232           //           ::Print("%-*.*s// ref      : %s",spaces,spaces," ",
233           //   piProcinfo(pi, "ref"));
234           break;
235         }
236       case LINK_CMD:
237          {
238            si_link l=(si_link)d;
239            PrintNSpaces(spaces);
240            ::Print("// type : %s\n", slStatus(l, "type"));
241            PrintNSpaces(spaces);
242            ::Print("// mode : %s\n", slStatus(l, "mode"));
243            PrintNSpaces(spaces);
244            ::Print("// name : %s\n", slStatus(l, "name"));
245            PrintNSpaces(spaces);
246            ::Print("// open : %s\n", slStatus(l, "open"));
247            PrintNSpaces(spaces);
248            ::Print("// read : %s\n", slStatus(l, "read"));
249            PrintNSpaces(spaces);
250            ::Print("// write: %s", slStatus(l, "write"));
251          break;
252          }
253        case BIGINT_CMD:
254          s=String(d);
255          if (s==NULL) return;
256          PrintNSpaces(spaces);
257          PrintS(s);
258          omFree((ADDRESS)s);
259          break;
260        case NUMBER_CMD:
261          {
262            number n=(number)d;
263            nNormalize(n);
264            if ((number)d !=n)
265            {
266              d=n;
267              if (rtyp==IDHDL) IDNUMBER(((idhdl)data))=n;
268              else if(rtyp==NUMBER_CMD) data=(void*)n;
269            }
270            s=String(d);
271            if (s==NULL) return;
272            PrintS(s);
273            omFree((ADDRESS)s);
274            break;
275          }
276        case LIST_CMD:
277        {
278          lists l=(lists)d;
279          if (lSize(l)<0)
280          {
281             PrintNSpaces(spaces);
282             PrintS("empty list\n");
283          }
284          else
285          {
286            int i=0;
287            for (;i<=l->nr;i++)
288            {
289              if (l->m[i].rtyp!=DEF_CMD)
290              {
291                PrintNSpaces(spaces);
292                ::Print("[%d]:\n",i+1);
293                l->m[i].Print(NULL,spaces+3);
294              }
295            }
296          }
297          break;
298        }
299
300        default:
301          if (t>MAX_TOK)
302          {
303            blackbox * bb=getBlackboxStuff(t);
304            PrintNSpaces(spaces);
305            if (bb!=NULL) { bb->blackbox_Print(bb,d); }
306            else          { ::Print("Print: blackbox %d(bb=NULL)",t); }
307          }
308          else
309          ::Print("Print:unknown type %s(%d)", Tok2Cmdname(t),t);
310      } /* end switch: (Typ()) */
311    if ((store!=NULL)&&(store!=this))
312      store->CleanUp();
313  }
314  if (next!=NULL)
315  {
316    if (t==COMMAND) PrintLn();
317    else if (t!=LIST_CMD) PrintS(" ");
318    next->Print(NULL,spaces);
319  }
320  else if ((t!=LIST_CMD)&&(t!=SMATRIX_CMD))
321  {
322    PrintLn();
323  }
324#ifdef SIQ
325  if (rtyp!=COMMAND)
326#endif
327  {
328    if ((store!=NULL)
329    && (store!=this))
330    {
331      if((t/*Typ()*/!=LINK_CMD)
332      && (t/*Typ()*/!=PACKAGE_CMD)
333      && (t/*Typ()*/!=DEF_CMD)
334      )
335      {
336        store->rtyp=t/*Typ()*/;
337        store->data=CopyD();
338        if(attribute!=NULL)
339        {
340          store->attribute=CopyA();
341        }
342        store->flag=flag;
343      }
344    }
345  }
346}
347
348void sleftv::CleanUp(ring r)
349{
350  if (rtyp!=IDHDL)
351  {
352    if ((name!=NULL) && (name!=sNoName_fe) && (rtyp!=ALIAS_CMD))
353    {
354      //::Print("free %x (%s)\n",name,name);
355      omFree((ADDRESS)name); // may be larger >1000 char (large int)
356    }
357    //name=NULL;
358    //flag=0;
359    if (data!=NULL)
360    {
361      //if (rtyp==IDHDL) attribute=NULL; // is only a pointer to attribute of id
362      s_internalDelete(rtyp,data,r);
363      //data=NULL; // will be done by Init() at the end
364    }
365    if (attribute!=NULL)
366    {
367      switch (rtyp)
368      {
369        case PACKAGE_CMD:
370        //case IDHDL:
371        case ANY_TYPE:
372        case VECHO:
373        case VPRINTLEVEL:
374        case VCOLMAX:
375        case VTIMER:
376        case VRTIMER:
377        case VOICE:
378        case VMAXDEG:
379        case VMAXMULT:
380        case TRACE:
381        case VSHORTOUT:
382        case VNOETHER:
383        case VMINPOLY:
384        case 0:
385          //attribute=NULL; // will be done by Init() at the end
386          break;
387        default:
388        {
389          attribute->killAll(r);
390        }
391      }
392    }
393  }
394  Subexpr h;
395  while (e!=NULL)
396  {
397    h=e->next;
398    omFreeBin((ADDRESS)e, sSubexpr_bin);
399    e=h;
400  }
401  //rtyp=NONE; // will be done by Init() at the end
402  if (next!=NULL)
403  {
404    leftv tmp_n;
405    do
406    {
407      tmp_n=next->next;
408      //next->name=NULL;
409      next->next=NULL;
410      next->CleanUp(r);
411      omFreeBin((ADDRESS)next, sleftv_bin);
412      next=tmp_n;
413    } while (next!=NULL);
414  }
415  Init();
416}
417
418BOOLEAN sleftv::RingDependend()
419{
420  int rt=Typ();
421  if(::RingDependend(rt))
422    return TRUE;
423  if (rt==LIST_CMD)
424    return lRingDependend((lists)Data());
425  if (this->next!=NULL)
426    return this->next->RingDependend();
427  return FALSE;
428}
429
430static inline void * s_internalCopy(const int t,  void *d)
431{
432  switch (t)
433  {
434    case CRING_CMD:
435      {
436        coeffs cf=(coeffs)d;
437        cf->ref++;
438        return (void*)d;
439      }
440#ifdef SINGULAR_4_2
441    case CNUMBER_CMD:
442      return (void*)n2Copy((number2)d);
443    case CPOLY_CMD:
444      return (void*)p2Copy((poly2)d);
445    case CMATRIX_CMD: // like BIGINTMAT
446#endif
447    case BIGINTMAT_CMD:
448      return (void*)bimCopy((bigintmat *)d);
449    case BUCKET_CMD:
450      return (void*)sBucketCopy((sBucket_pt)d);
451    case INTVEC_CMD:
452    case INTMAT_CMD:
453      return (void *)ivCopy((intvec *)d);
454    case MATRIX_CMD:
455      return (void *)mp_Copy((matrix)d, currRing);
456    case SMATRIX_CMD:
457    case IDEAL_CMD:
458    case MODUL_CMD:
459      return  (void *)idCopy((ideal)d);
460    case STRING_CMD:
461        return (void *)omStrDup((char *)d);
462    case PACKAGE_CMD:
463      return  (void *)paCopy((package) d);
464    case PROC_CMD:
465      return  (void *)piCopy((procinfov) d);
466    case POLY_CMD:
467    case VECTOR_CMD:
468      return  (void *)pCopy((poly)d);
469    case INT_CMD:
470      return  d;
471    case NUMBER_CMD:
472      return  (void *)nCopy((number)d);
473    case BIGINT_CMD:
474      return  (void *)n_Copy((number)d, coeffs_BIGINT);
475    case MAP_CMD:
476      return  (void *)maCopy((map)d, currRing);
477    case LIST_CMD:
478      return  (void *)lCopy((lists)d);
479    case LINK_CMD:
480      return (void *)slCopy((si_link) d);
481    case RING_CMD:
482      {
483        ring r=(ring)d;
484        if (r!=NULL)
485        {
486          rIncRefCnt(r);
487          //Print("s_internalCopy:+  ring %lx, ref %d\n",r,r->ref);
488        }
489        return d;
490      }
491    case RESOLUTION_CMD:
492      return (void*)syCopy((syStrategy)d);
493    case DEF_CMD:
494    case NONE:
495    case 0: /* type in error case */
496      break; /* error recovery: do nothing */
497    //case COMMAND:
498    default:
499    {
500      if (t>MAX_TOK)
501      {
502        blackbox *b=getBlackboxStuff(t);
503        if (b!=NULL) return b->blackbox_Copy(b,d);
504        return NULL;
505      }
506      else
507      Warn("s_internalCopy: cannot copy type %s(%d)",
508            Tok2Cmdname(t),t);
509    }
510  }
511  return NULL;
512}
513
514void s_internalDelete(const int t,  void *d, const ring r)
515{
516  assume(d!=NULL);
517  switch (t)
518  {
519    case CRING_CMD:
520      {
521        coeffs cf=(coeffs)d;
522        if ((cf->ref<1)&&
523        ((cf->type <=n_GF)
524          ||((cf->type >=n_long_C)&&(cf->type <=n_CF))))
525        {
526          Warn("cannot kill `%s`",nCoeffName(cf));
527        }
528        else // allow nKillChar for n_long_R, extensions, and user defined:
529          nKillChar((coeffs)d);
530        break;
531      }
532#ifdef SINGULAR_4_2
533    case CNUMBER_CMD:
534      {
535        number2 n=(number2)d;
536        n2Delete(n);
537        break;
538      }
539    case CPOLY_CMD:
540      {
541        poly2 n=(poly2)d;
542        p2Delete(n);
543        break;
544      }
545    case CMATRIX_CMD: //like BIGINTMAT
546#endif
547    case BIGINTMAT_CMD:
548    {
549      bigintmat *v=(bigintmat*)d;
550      delete v;
551      break;
552    }
553    case BUCKET_CMD:
554    {
555      sBucket_pt b=(sBucket_pt)d;
556      sBucketDeleteAndDestroy(&b);
557      break;
558    }
559    case INTVEC_CMD:
560    case INTMAT_CMD:
561    {
562      intvec *v=(intvec*)d;
563      delete v;
564      break;
565    }
566    case MAP_CMD:
567    {
568      map m=(map)d;
569      omFreeBinAddr((ADDRESS)m->preimage);
570      m->preimage=NULL;
571      /* no break: continue as IDEAL*/
572    }
573    case SMATRIX_CMD:
574    case MATRIX_CMD:
575    case IDEAL_CMD:
576    case MODUL_CMD:
577    {
578      ideal i=(ideal)d;
579      id_Delete(&i,r);
580      break;
581    }
582    case STRING_CMD:
583      omFree(d);
584      break;
585    //case PACKAGE_CMD:
586    //  return  (void *)paCopy((package) d);
587    case PROC_CMD:
588      piKill((procinfo*)d);
589      break;
590    case POLY_CMD:
591    case VECTOR_CMD:
592    {
593      poly p=(poly)d;
594      p_Delete(&p,r);
595      break;
596    }
597    case NUMBER_CMD:
598    {
599      number n=(number)d;
600      n_Delete(&n,r->cf);
601      break;
602    }
603    case BIGINT_CMD:
604    {
605      number n=(number)d;
606      n_Delete(&n,coeffs_BIGINT);
607      break;
608    }
609    case LIST_CMD:
610    {
611      lists l=(lists)d;
612      l->Clean(r);
613      break;
614    }
615    case LINK_CMD:
616    {
617      si_link l=(si_link)d;
618      slKill(l);
619      break;
620    }
621    case RING_CMD:
622    {
623      ring R=(ring)d;
624      if ((R!=currRing)||(R->ref>=0))
625        rKill(R);
626      #ifdef TEST
627      else
628        Print("currRing? ref=%d\n",R->ref);
629      #endif
630      break;
631    }
632    case RESOLUTION_CMD:
633    {
634      syStrategy s=(syStrategy)d;
635      if (s!=NULL) syKillComputation(s,r);
636      break;
637    }
638    case COMMAND:
639    {
640     command cmd=(command)d;
641     if (cmd->arg1.rtyp!=0) cmd->arg1.CleanUp(r);
642     if (cmd->arg2.rtyp!=0) cmd->arg2.CleanUp(r);
643     if (cmd->arg3.rtyp!=0) cmd->arg3.CleanUp(r);
644     omFreeBin((ADDRESS)d, sip_command_bin);
645     break;
646    }
647    case INT_CMD:
648    case DEF_CMD:
649    case ALIAS_CMD:
650    case PACKAGE_CMD:
651    case IDHDL:
652    case NONE:
653    case ANY_TYPE:
654    case VECHO:
655    case VPRINTLEVEL:
656    case VCOLMAX:
657    case VTIMER:
658    case VRTIMER:
659    case VOICE:
660    case VMAXDEG:
661    case VMAXMULT:
662    case TRACE:
663    case VSHORTOUT:
664    case VNOETHER:
665    case VMINPOLY:
666    case 0: /* type in error case */
667      break; /* error recovery: do nothing */
668    //case COMMAND:
669    //case COMMAND:
670    default:
671    {
672      if (t>MAX_TOK)
673      {
674        blackbox *b=getBlackboxStuff(t);
675        if (b!=NULL) b->blackbox_destroy(b,d);
676        break;
677      }
678      else
679      Warn("s_internalDelete: cannot delete type %s(%d)",
680            Tok2Cmdname(t),t);
681    }
682  }
683}
684
685void sleftv::Copy(leftv source)
686{
687  Init();
688  rtyp=source->Typ();
689  void *d=source->Data();
690  if(!errorreported)
691  {
692    if (rtyp==BUCKET_CMD)
693    {
694      rtyp=POLY_CMD;
695      data=(void*)pCopy(sBucketPeek((sBucket_pt)d));
696    }
697    else
698      data=s_internalCopy(rtyp,d);
699    if ((source->attribute!=NULL)||(source->e!=NULL))
700      attribute=source->CopyA();
701    flag=source->flag;
702    if (source->next!=NULL)
703    {
704      next=(leftv)omAllocBin(sleftv_bin);
705      next->Copy(source->next);
706    }
707  }
708}
709
710void * sleftv::CopyD(int t)
711{
712  if (Sy_inset(FLAG_OTHER_RING,flag))
713  {
714     flag&=~Sy_bit(FLAG_OTHER_RING);
715     WerrorS("object from another ring");
716     return NULL;
717  }
718
719  if ((rtyp!=IDHDL)&&(rtyp!=ALIAS_CMD)&&(e==NULL))
720  {
721    if (iiCheckRing(t)) return NULL;
722    void *x = data;
723    if (rtyp==VNOETHER) x = (void *)pCopy((currRing->ppNoether));
724    else if ((rtyp==VMINPOLY) && nCoeff_is_algExt(currRing->cf) && (!nCoeff_is_GF(currRing->cf)))
725    {
726      const ring A = currRing->cf->extRing;
727
728      assume( A != NULL );
729      assume( A->qideal != NULL );
730
731      x=(void *)p_Copy(A->qideal->m[0], A);
732    }
733    data=NULL;
734    return x;
735  }
736  void *d=Data(); // will also do a iiCheckRing
737  if ((!errorreported) && (d!=NULL)) return s_internalCopy(t,d);
738  return NULL;
739}
740
741//void * sleftv::CopyD()
742//{
743  //if ((rtyp!=IDHDL)&&(e==NULL)
744  //&&(rtyp!=VNOETHER)&&(rtyp!=VMINPOLY))
745  //{
746  //  void *x=data;
747  //  data=NULL;
748  //  return x;
749  //}
750//  return CopyD(Typ());
751//}
752
753attr sleftv::CopyA()
754{
755  attr *a=Attribute();
756  if ((a!=NULL) && (*a!=NULL))
757    return (*a)->Copy();
758  return NULL;
759}
760
761char *  sleftv::String(void *d, BOOLEAN typed, int dim)
762{
763#ifdef SIQ
764  if (rtyp==COMMAND)
765  {
766    ::Print("##command %d\n",((command)data)->op);
767    if (((command)data)->arg1.rtyp!=0)
768      ((command)data)->arg1.Print(NULL,2);
769    if (((command)data)->arg2.rtyp!=0)
770      ((command)data)->arg2.Print(NULL,2);
771    if (((command)data)->arg3.rtyp==0)
772      ((command)data)->arg3.Print(NULL,2);
773    PrintS("##end\n");
774    return omStrDup("");
775  }
776#endif
777  if (d==NULL) d=Data();
778  if (!errorreported)
779  {
780    char *s;
781    int t=Typ();
782    switch (t /*Typ()*/)
783    {
784        case INT_CMD:
785          if (typed)
786          {
787            s=(char *)omAlloc(MAX_INT_LEN+7);
788            sprintf(s,"int(%d)",(int)(long)d);
789          }
790          else
791          {
792            s=(char *)omAlloc(MAX_INT_LEN+2);
793            sprintf(s,"%d",(int)(long)d);
794          }
795          return s;
796
797        case STRING_CMD:
798          if (d == NULL)
799          {
800            if (typed) return omStrDup("\"\"");
801            return omStrDup("");
802          }
803          if (typed)
804          {
805            s = (char*) omAlloc(strlen((char*) d) + 3);
806            sprintf(s,"\"%s\"", (char*) d);
807            return s;
808          }
809          else
810          {
811            return omStrDup((char*)d);
812          }
813
814        case POLY_CMD:
815        case VECTOR_CMD:
816          if (typed)
817          {
818            char* ps = pString((poly) d);
819            s = (char*) omAlloc(strlen(ps) + 10);
820            sprintf(s,"%s(%s)", (t /*Typ()*/ == POLY_CMD ? "poly" : "vector"), ps);
821            omFree(ps);
822            return s;
823          }
824          else
825            return pString((poly)d);
826
827        case CRING_CMD:
828          return nCoeffString((coeffs)d);
829        #ifdef SINGULAR_4_2
830        case CNUMBER_CMD:
831          return n2String((number2)d,typed);
832        case CMATRIX_CMD:
833          {
834            bigintmat *b=(bigintmat*)d;
835            return b->String();
836          }
837        #endif
838
839        case NUMBER_CMD:
840          StringSetS((char*) (typed ? "number(" : ""));
841          if((rtyp==VMINPOLY)&&(rField_is_GF(currRing)))
842          {
843            nfShowMipo(currRing->cf);
844          }
845          else
846          {
847            nWrite((number)d);
848          }
849          StringAppendS((char*) (typed ? ")" : ""));
850          return StringEndS();
851
852        case BIGINT_CMD:
853          {
854          StringSetS((char*) (typed ? "bigint(" : ""));
855          number nl=(number)d;
856          n_Write(nl,coeffs_BIGINT);
857          StringAppendS((char*) (typed ? ")" : ""));
858          return StringEndS();
859          }
860        case BUCKET_CMD:
861          return sBucketString((sBucket_pt)d);
862        case MATRIX_CMD:
863          s= iiStringMatrix((matrix)d,dim, currRing);
864          if (typed)
865          {
866            char* ns = (char*) omAlloc(strlen(s) + 40);
867            sprintf(ns, "matrix(ideal(%s),%d,%d)", s,
868                    ((ideal) d)->nrows, ((ideal) d)->ncols);
869            omCheckAddr(ns);
870            return ns;
871          }
872          else
873          {
874            return omStrDup(s);
875          }
876
877        case IDEAL_CMD:
878        case MAP_CMD:
879        case MODUL_CMD:
880        case SMATRIX_CMD:
881          s= iiStringMatrix((matrix)d,dim, currRing);
882          if (typed)
883          {
884            char* ns = (char*) omAlloc(strlen(s) + 10);
885            if ((t/*Typ()*/==IDEAL_CMD)||(t==MAP_CMD))
886              sprintf(ns, "ideal(%s)", s);
887            else /*MODUL_CMD, SMATRIX_CMD */
888              sprintf(ns, "module(%s)", s);
889            omFree(s);
890            omCheckAddr(ns);
891            return ns;
892          }
893          return s;
894
895        case INTVEC_CMD:
896        case INTMAT_CMD:
897        {
898          intvec *v=(intvec *)d;
899          s = v->String(dim);
900          if (typed)
901          {
902            char* ns;
903            if (t/*Typ()*/ == INTMAT_CMD)
904            {
905              ns = (char*) omAlloc(strlen(s) + 40);
906              sprintf(ns, "intmat(intvec(%s),%d,%d)", s, v->rows(), v->cols());
907            }
908            else
909            {
910              ns = (char*) omAlloc(strlen(s) + 10);
911              sprintf(ns, "intvec(%s)", s);
912            }
913            omCheckAddr(ns);
914            omFree(s);
915            return ns;
916          }
917          else
918            return s;
919        }
920        case BIGINTMAT_CMD:
921        {
922          bigintmat *bim=(bigintmat*)d;
923          s = bim->String();
924          if (typed)
925          {
926            char* ns = (char*) omAlloc0(strlen(s) + 40);
927            sprintf(ns, "bigintmat(bigintvec(%s),%d,%d)", s, bim->rows(), bim->cols());
928            omCheckAddr(ns);
929            return ns;
930          }
931          else
932            return omStrDup(s);
933        }
934
935        case RING_CMD:
936          s  = rString((ring)d);
937
938          if (typed)
939          {
940            char* ns;
941            ring r=(ring)d;
942            if (r->qideal!=NULL)
943            {
944              char* id = iiStringMatrix((matrix) ((ring) d)->qideal, dim,
945                              currRing);
946              ns = (char*) omAlloc(strlen(s) + strlen(id) + 20);
947              sprintf(ns, "\"%s\";%sideal(%s)", s,(dim == 2 ? "\n" : " "), id);
948            }
949            else
950            {
951              ns = (char*) omAlloc(strlen(s) + 4);
952              sprintf(ns, "\"%s\"", s);
953            }
954            omFree(s);
955            omCheckAddr(ns);
956            return ns;
957          }
958          return s;
959        case RESOLUTION_CMD:
960        {
961          lists l = syConvRes((syStrategy)d);
962          s = lString(l, typed, dim);
963          l->Clean();
964          return s;
965        }
966
967        case PROC_CMD:
968        {
969          procinfo* pi = (procinfo*) d;
970          if((pi->language == LANG_SINGULAR) && (pi->data.s.body!=NULL))
971            s = (pi->data.s.body);
972          else
973            s = (char *)"";
974          if (typed)
975          {
976            char* ns = (char*) omAlloc(strlen(s) + 4);
977            sprintf(ns, "\"%s\"", s);
978            omCheckAddr(ns);
979            return ns;
980          }
981          return omStrDup(s);
982        }
983
984        case LINK_CMD:
985          s = slString((si_link) d);
986          if (typed)
987          {
988            char* ns = (char*) omAlloc(strlen(s) + 10);
989            sprintf(ns, "link(\"%s\")", s);
990            omFreeBinAddr(s);
991            omCheckAddr(ns);
992            return ns;
993          }
994          return s;
995
996        case LIST_CMD:
997          return lString((lists) d, typed, dim);
998
999        default:
1000          if(t> MAX_TOK)
1001          {
1002            blackbox *bb=getBlackboxStuff(t);
1003            if (bb!=NULL) return bb->blackbox_String(bb,d);
1004          }
1005    } /* end switch: (Typ()) */
1006  }
1007  return omStrDup("");
1008}
1009
1010
1011int  sleftv::Typ()
1012{
1013  if (e==NULL)
1014  {
1015    switch (rtyp)
1016    {
1017      case IDHDL:
1018        return IDTYP((idhdl)data);
1019      case ALIAS_CMD:
1020         {
1021           idhdl h=(idhdl)data;
1022           return  ((idhdl)h->data.ustring)->typ;
1023         }
1024      case VECHO:
1025      case VPRINTLEVEL:
1026      case VCOLMAX:
1027      case VTIMER:
1028      case VRTIMER:
1029      case VOICE:
1030      case VMAXDEG:
1031      case VMAXMULT:
1032      case TRACE:
1033      case VSHORTOUT:
1034        return INT_CMD;
1035      case VMINPOLY:
1036        data=NULL;
1037        return NUMBER_CMD;
1038      case VNOETHER:
1039        data=NULL;
1040        return POLY_CMD;
1041      //case COMMAND:
1042      //  return COMMAND;
1043      default:
1044        return rtyp;
1045    }
1046  }
1047  int r=0;
1048  int t=rtyp;
1049  void *d=data;
1050  if (t==IDHDL) t=IDTYP((idhdl)d);
1051  else if (t==ALIAS_CMD)
1052  { idhdl h=(idhdl)IDDATA((idhdl)data); t=IDTYP(h);d=IDDATA(h); }
1053  switch (t)
1054  {
1055#ifdef SINGULAR_4_2
1056    case CMATRIX_CMD:
1057    {
1058      bigintmat *b=(bigintmat*)d;
1059      if ((currRing!=NULL)&&(currRing->cf==b->basecoeffs()))
1060        return NUMBER_CMD;
1061      else
1062        return CNUMBER_CMD;
1063    }
1064#endif
1065    case INTVEC_CMD:
1066    case INTMAT_CMD:
1067      r=INT_CMD;
1068      break;
1069    case BIGINTMAT_CMD:
1070      r=BIGINT_CMD;
1071      break;
1072    case IDEAL_CMD:
1073    case MATRIX_CMD:
1074    case MAP_CMD:
1075    case SMATRIX_CMD:
1076      r=POLY_CMD;
1077      break;
1078    case MODUL_CMD:
1079      r=VECTOR_CMD;
1080      break;
1081    case STRING_CMD:
1082      r=STRING_CMD;
1083      break;
1084    default:
1085    {
1086      blackbox *b=NULL;
1087      if (t>MAX_TOK)
1088      {
1089        b=getBlackboxStuff(t);
1090      }
1091      if ((t==LIST_CMD)||((b!=NULL)&&BB_LIKE_LIST(b)))
1092      {
1093        lists l;
1094        if (rtyp==IDHDL) l=IDLIST((idhdl)d);
1095        else             l=(lists)d;
1096        if ((0<e->start)&&(e->start<=l->nr+1))
1097        {
1098          Subexpr tmp=l->m[e->start-1].e;
1099          l->m[e->start-1].e=e->next;
1100          r=l->m[e->start-1].Typ();
1101          e->next=l->m[e->start-1].e;
1102          l->m[e->start-1].e=tmp;
1103        }
1104        else
1105        {
1106          //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
1107          r=DEF_CMD;
1108        }
1109      }
1110      else
1111        Werror("cannot index type %s(%d)",Tok2Cmdname(t),t);
1112      break;
1113    }
1114  }
1115  return r;
1116}
1117
1118int  sleftv::LTyp()
1119{
1120  lists l=NULL;
1121  int r;
1122  if (rtyp==LIST_CMD)
1123    l=(lists)data;
1124  else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1125    l=IDLIST((idhdl)data);
1126  else
1127    return Typ();
1128  //if (l!=NULL)
1129  {
1130    if ((e!=NULL) && (e->next!=NULL))
1131    {
1132      if ((0<e->start)&&(e->start<=l->nr+1))
1133      {
1134        l->m[e->start-1].e=e->next;
1135        r=l->m[e->start-1].LTyp();
1136        l->m[e->start-1].e=NULL;
1137      }
1138      else
1139      {
1140        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
1141        r=NONE;
1142      }
1143      return r;
1144    }
1145    return LIST_CMD;
1146  }
1147  return Typ();
1148}
1149
1150#ifdef SINGULAR_4_2
1151STATIC_VAR snumber2 iiNumber2Data[4];
1152STATIC_VAR int iiCmatrix_index=0;
1153#endif
1154void * sleftv::Data()
1155{
1156  if ((rtyp!=IDHDL) && iiCheckRing(rtyp))
1157     return NULL;
1158  if (Sy_inset(FLAG_OTHER_RING,flag))
1159  {
1160     flag&=~Sy_bit(FLAG_OTHER_RING);
1161     WerrorS("object from another ring");
1162     return NULL;
1163  }
1164  if (e==NULL)
1165  {
1166    switch (rtyp)
1167    {
1168      case ALIAS_CMD:
1169      {
1170        idhdl h=(idhdl)data;
1171        return  ((idhdl)h->data.ustring)->data.ustring;
1172      }
1173      case VECHO:      return (void *)(long)si_echo;
1174      case VPRINTLEVEL:return (void *)(long)printlevel;
1175      case VCOLMAX:    return (void *)(long)colmax;
1176      case VTIMER:     return (void *)(long)getTimer();
1177      case VRTIMER:    return (void *)(long)getRTimer();
1178      case VOICE:      return (void *)(long)(myynest+1);
1179      case VMAXDEG:    return (void *)(long)Kstd1_deg;
1180      case VMAXMULT:   return (void *)(long)Kstd1_mu;
1181      case TRACE:      return (void *)(long)traceit;
1182      case VSHORTOUT:  return (void *)(long)(currRing != NULL ? currRing->ShortOut : 0);
1183      case VMINPOLY:
1184        if ( (currRing != NULL)  && nCoeff_is_algExt(currRing->cf) && !nCoeff_is_GF(currRing->cf))
1185        {
1186          /* Q(a), Fp(a), but not GF(q) */
1187          const ring A = currRing->cf->extRing;
1188
1189          assume( A != NULL );
1190          assume( A->qideal != NULL );
1191
1192          return (void *)A->qideal->m[0];
1193        }
1194        else
1195          return (void *)nInit(0);
1196
1197      case VNOETHER:   return (void *) (currRing->ppNoether);
1198      case IDHDL:
1199        return IDDATA((idhdl)data);
1200      case COMMAND:
1201        //return NULL;
1202      default:
1203        return data;
1204    }
1205  }
1206  /* e != NULL : */
1207  int t=rtyp;
1208  void *d=data;
1209  if (t==IDHDL)
1210  {
1211    t=((idhdl)data)->typ;
1212    d=IDDATA((idhdl)data);
1213  }
1214  else if (t==ALIAS_CMD)
1215  {
1216    idhdl h=(idhdl)IDDATA((idhdl)data);
1217    t=IDTYP(h);
1218    d=IDDATA(h);
1219  }
1220  if (iiCheckRing(t))
1221    return NULL;
1222  char *r=NULL;
1223  int index=e->start;
1224  switch (t)
1225  {
1226    case INTVEC_CMD:
1227    {
1228      intvec *iv=(intvec *)d;
1229      if ((index<1)||(index>iv->length()))
1230      {
1231        if (!errorreported)
1232          Werror("wrong range[%d] in intvec %s(%d)",index,this->Name(),iv->length());
1233      }
1234      else
1235        r=(char *)(long)((*iv)[index-1]);
1236      break;
1237    }
1238    case INTMAT_CMD:
1239    {
1240      intvec *iv=(intvec *)d;
1241      if ((index<1)
1242         ||(index>iv->rows())
1243         ||(e->next->start<1)
1244         ||(e->next->start>iv->cols()))
1245      {
1246        if (!errorreported)
1247        Werror("wrong range[%d,%d] in intmat %s(%dx%d)",index,e->next->start,
1248                                           this->Name(),iv->rows(),iv->cols());
1249      }
1250      else
1251        r=(char *)(long)(IMATELEM((*iv),index,e->next->start));
1252      break;
1253    }
1254    case BIGINTMAT_CMD:
1255    {
1256      bigintmat *m=(bigintmat *)d;
1257      if ((index<1)
1258         ||(index>m->rows())
1259         ||(e->next->start<1)
1260         ||(e->next->start>m->cols()))
1261      {
1262        if (!errorreported)
1263        Werror("wrong range[%d,%d] in bigintmat %s(%dx%d)",index,e->next->start,
1264                                                     this->Name(),m->rows(),m->cols());
1265      }
1266      else
1267        r=(char *)(BIMATELEM((*m),index,e->next->start));
1268      break;
1269    }
1270#ifdef SINGULAR_4_2
1271    case CMATRIX_CMD:
1272    {
1273      bigintmat *m=(bigintmat *)d;
1274      if ((index<1)
1275         ||(index>m->rows())
1276         ||(e->next->start<1)
1277         ||(e->next->start>m->cols()))
1278      {
1279        if (!errorreported)
1280        Werror("wrong range[%d,%d] in matrix %s(%dx%d)",index,e->next->start,
1281                                                     this->Name(),m->rows(),m->cols());
1282      }
1283      else
1284      {
1285        iiNumber2Data[iiCmatrix_index].cf=m->basecoeffs();
1286        iiNumber2Data[iiCmatrix_index].n=BIMATELEM((*m),index,e->next->start);
1287        r=(char*)&iiNumber2Data[iiCmatrix_index];
1288        iiCmatrix_index=(iiCmatrix_index+1) % 4;
1289      }
1290      break;
1291    }
1292#endif
1293    case IDEAL_CMD:
1294    case MODUL_CMD:
1295    case MAP_CMD:
1296    {
1297      ideal I=(ideal)d;
1298      if ((index<1)||(index>IDELEMS(I)))
1299      {
1300        if (!errorreported)
1301          Werror("wrong range[%d] in ideal/module %s(%d)",index,this->Name(),IDELEMS(I));
1302      }
1303      else
1304        r=(char *)I->m[index-1];
1305      break;
1306    }
1307    case SMATRIX_CMD:
1308    {
1309      ideal I=(ideal)d;
1310      int c;
1311      sleftv tmp;
1312      tmp.Init();
1313      tmp.rtyp=POLY_CMD;
1314      if ((index>0)&& (index<=I->rank)
1315      && (e->next!=NULL)
1316      && ((c=e->next->start)>0) &&(c<=IDELEMS(I)))
1317      {
1318        r=(char*)SMATELEM(I,index-1,c-1,currRing);
1319      }
1320      else
1321      {
1322        r=NULL;
1323      }
1324      tmp.data=r;
1325      if ((rtyp==IDHDL)||(rtyp==SMATRIX_CMD))
1326      {
1327        tmp.next=next; next=NULL;
1328        d=NULL;
1329        CleanUp();
1330        memcpy(this,&tmp,sizeof(tmp));
1331      }
1332      // and, remember, r is also the result...
1333      else
1334      {
1335        // ???
1336        // here we still have a memory leak...
1337        // example: list L="123","456";
1338        // L[1][2];
1339        // therefore, it should never happen:
1340        assume(0);
1341        // but if it happens: here is the temporary fix:
1342        // omMarkAsStaticAddr(r);
1343      }
1344      break;
1345    }
1346    case STRING_CMD:
1347    {
1348      // this was a memory leak
1349      // we evalute it, cleanup and replace this leftv by it's evalutated form
1350      // the evalutated form will be build in tmp
1351      sleftv tmp;
1352      tmp.Init();
1353      tmp.rtyp=STRING_CMD;
1354      r=(char *)omAllocBin(size_two_bin);
1355      if ((index>0)&& (index<=(int)strlen((char *)d)))
1356      {
1357        r[0]=*(((char *)d)+index-1);
1358        r[1]='\0';
1359      }
1360      else
1361      {
1362        r[0]='\0';
1363      }
1364      tmp.data=r;
1365      if ((rtyp==IDHDL)||(rtyp==STRING_CMD))
1366      {
1367        tmp.next=next; next=NULL;
1368        //if (rtyp==STRING_CMD) { omFree((ADDRESS)data); }
1369        //data=NULL;
1370        d=NULL;
1371        CleanUp();
1372        memcpy(this,&tmp,sizeof(tmp));
1373      }
1374      // and, remember, r is also the result...
1375      else
1376      {
1377        // ???
1378        // here we still have a memory leak...
1379        // example: list L="123","456";
1380        // L[1][2];
1381        // therefore, it should never happen:
1382        assume(0);
1383        // but if it happens: here is the temporary fix:
1384        // omMarkAsStaticAddr(r);
1385      }
1386      break;
1387    }
1388    case MATRIX_CMD:
1389    {
1390      if ((index<1)
1391         ||(index>MATROWS((matrix)d))
1392         ||(e->next->start<1)
1393         ||(e->next->start>MATCOLS((matrix)d)))
1394      {
1395        if (!errorreported)
1396          Werror("wrong range[%d,%d] in matrix %s(%dx%d)",
1397                  index,e->next->start,
1398                  this->Name(),
1399                  MATROWS((matrix)d),MATCOLS((matrix)d));
1400      }
1401      else
1402        r=(char *)MATELEM((matrix)d,index,e->next->start);
1403      break;
1404    }
1405    default:
1406    {
1407      blackbox *b=NULL;
1408      if (t>MAX_TOK)
1409      {
1410        b=getBlackboxStuff(t);
1411      }
1412      if ((t==LIST_CMD)||((b!=NULL)&&(BB_LIKE_LIST(b))))
1413      {
1414        lists l=(lists)d;
1415        if ((0<index)&&(index<=l->nr+1))
1416        {
1417          if ((e->next!=NULL)
1418          && (l->m[index-1].rtyp==STRING_CMD))
1419          // string[..].Data() modifies sleftv, so let's do it ourself
1420          {
1421            char *dd=(char *)l->m[index-1].data;
1422            int j=e->next->start-1;
1423            r=(char *)omAllocBin(size_two_bin);
1424            if ((j>=0) && (j<(int)strlen(dd)))
1425            {
1426              r[0]=*(dd+j);
1427              r[1]='\0';
1428            }
1429            else
1430            {
1431              r[0]='\0';
1432            }
1433          }
1434          else
1435          {
1436            Subexpr tmp=l->m[index-1].e;
1437            l->m[index-1].e=e->next;
1438            r=(char *)l->m[index-1].Data();
1439            e->next=l->m[index-1].e;
1440            l->m[index-1].e=tmp;
1441          }
1442        }
1443        else //if (!errorreported)
1444          Werror("wrong range[%d] in list %s(%d)",index,this->Name(),l->nr+1);
1445      }
1446      else
1447        Werror("cannot index %s of type %s(%d)",this->Name(),Tok2Cmdname(t),t);
1448      break;
1449    }
1450  }
1451  return r;
1452}
1453
1454attr * sleftv::Attribute()
1455{
1456  if (e==NULL) return &attribute;
1457  if ((rtyp==LIST_CMD)
1458  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD))
1459  || (rtyp>MAX_TOK)
1460  || ((rtyp==IDHDL)&&(IDTYP((idhdl)data)>MAX_TOK)))
1461  {
1462    leftv v=LData();
1463    return &(v->attribute);
1464  }
1465  return NULL;
1466}
1467
1468leftv sleftv::LData()
1469{
1470  if (e!=NULL)
1471  {
1472    lists l=NULL;
1473    blackbox *b=getBlackboxStuff(rtyp);
1474
1475    if ((rtyp==LIST_CMD)
1476    || ((b!=NULL)&&(BB_LIKE_LIST(b))))
1477      l=(lists)data;
1478    else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1479      l=IDLIST((idhdl)data);
1480    else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)>MAX_TOK))
1481    {
1482      b=getBlackboxStuff(IDTYP((idhdl)data));
1483      if (BB_LIKE_LIST(b)) l=IDLIST((idhdl)data);
1484    }
1485    else if (rtyp==ALIAS_CMD)
1486    {
1487      idhdl h=(idhdl)data;
1488      l= (lists)(((idhdl)h->data.ustring)->data.ustring);
1489    }
1490    if (l!=NULL)
1491    {
1492      if ((0>=e->start)||(e->start>l->nr+1))
1493        return NULL;
1494      if (e->next!=NULL)
1495      {
1496        l->m[e->start-1].e=e->next;
1497        leftv r=l->m[e->start-1].LData();
1498        l->m[e->start-1].e=NULL;
1499        return r;
1500      }
1501      return &(l->m[e->start-1]);
1502    }
1503  }
1504  return this;
1505}
1506
1507#if 0
1508leftv sleftv::LHdl()
1509{
1510  if (e!=NULL)
1511  {
1512    lists l=NULL;
1513
1514    if (rtyp==LIST_CMD)
1515      l=(lists)data;
1516    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1517      l=IDLIST((idhdl)data);
1518    if (l!=NULL)
1519    {
1520      if ((0>=e->start)||(e->start>l->nr+1))
1521        return NULL;
1522      if (e->next!=NULL)
1523      {
1524        l->m[e->start-1].e=e->next;
1525        leftv r=l->m[e->start-1].LHdl();
1526        l->m[e->start-1].e=NULL;
1527        return r;
1528      }
1529      return &(l->m[e->start-1]);
1530    }
1531  }
1532  return this;
1533}
1534#endif
1535
1536BOOLEAN assumeStdFlag(leftv h)
1537{
1538  if (h->e!=NULL)
1539  {
1540    leftv hh=h->LData();
1541    if (h!=hh) return assumeStdFlag(h->LData());
1542  }
1543  if (!hasFlag(h,FLAG_STD))
1544  {
1545    if (!TEST_VERB_NSB)
1546    {
1547      if (TEST_V_ALLWARN)
1548        Warn("%s is no standard basis in >>%s<<",h->Name(),my_yylinebuf);
1549      else
1550        Warn("%s is no standard basis",h->Name());
1551    }
1552    return FALSE;
1553  }
1554  return TRUE;
1555}
1556
1557/*2
1558* transforms a name (as an string created by omAlloc or omStrDup)
1559* into an expression (sleftv), deletes the string
1560* utility for grammar and iparith
1561*/
1562void syMake(leftv v,const char * id, package pa)
1563{
1564  /* resolv an identifier: (to DEF_CMD, if siq>0)
1565  * 1) reserved id: done by scanner
1566  * 2) `basering` / 'Current`
1567  * 3) existing identifier, local
1568  * 4) ringvar, ringpar, local ring
1569  * 5) existing identifier, global
1570  * 6) monom (resp. number), local ring: consisting of:
1571  * 6') ringvar,  ringpar,global ring
1572  * 6'') monom (resp. number), local ring
1573  * 7) monom (resp. number), non-local ring
1574  * 8) basering
1575  * 9) `_`
1576  * 10) everything else is of type 0
1577  */
1578#ifdef TEST
1579  if ((*id<' ')||(*id>(char)126))
1580  {
1581    Print("wrong id :%s:\n",id);
1582  }
1583#endif
1584  idhdl save_ring=currRingHdl;
1585  v->Init();
1586  if(pa != NULL)
1587  {
1588    v->req_packhdl = pa;
1589  }
1590  else v->req_packhdl = currPack;
1591//  if (v->req_packhdl!=basePack)
1592//    Print("search %s in %s\n",id,v->req_packhdl->libname);
1593  idhdl h=NULL;
1594#ifdef SIQ
1595  if (siq<=0)
1596#endif
1597  {
1598    if (strcmp(id,"basering")==0)
1599    {
1600      if (currRingHdl!=NULL)
1601      {
1602        if (id!=IDID(currRingHdl)) omFreeBinAddr((ADDRESS)id);
1603        h=currRingHdl;
1604        goto id_found;
1605      }
1606      else
1607      {
1608        v->name = id;
1609        return; /* undefined */
1610      }
1611    }
1612    else if (strcmp(id,"Current")==0)
1613    {
1614      if (currPackHdl!=NULL)
1615      {
1616        omFreeBinAddr((ADDRESS)id);
1617        h=currPackHdl;
1618        goto id_found;
1619      }
1620      else
1621      {
1622        v->name = id;
1623        return; /* undefined */
1624      }
1625    }
1626    if(v->req_packhdl!=currPack)
1627    {
1628      h=v->req_packhdl->idroot->get(id,myynest);
1629    }
1630    else
1631    {
1632      h=ggetid(id);
1633    }
1634    /* 3) existing identifier, local */
1635    if ((h!=NULL) && (IDLEV(h)==myynest))
1636    {
1637      if (id!=IDID(h)) omFreeBinAddr((ADDRESS)id); /*assume strlen(id) <1000 */
1638      goto id_found;
1639    }
1640    if (yyInRingConstruction)
1641    {
1642      currRingHdl=NULL;
1643    }
1644    /* 4. local ring: ringvar */
1645    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest)
1646    /*&& (!yyInRingConstruction)*/)
1647    {
1648      int vnr;
1649      if ((vnr=r_IsRingVar(id, currRing->names,currRing->N))>=0)
1650      {
1651        poly p=pOne();
1652        pSetExp(p,vnr+1,1);
1653        pSetm(p);
1654        v->data = (void *)p;
1655        v->name = id;
1656        v->rtyp = POLY_CMD;
1657        return;
1658      }
1659      if((n_NumberOfParameters(currRing->cf)>0)
1660      &&((vnr=r_IsRingVar(id, (char**)n_ParameterNames(currRing->cf),
1661                              n_NumberOfParameters(currRing->cf))>=0)))
1662      {
1663        BOOLEAN ok=FALSE;
1664        poly p = pmInit(id,ok);
1665        if (ok && (p!=NULL))
1666        {
1667          v->data = pGetCoeff(p);
1668          pGetCoeff(p)=NULL;
1669          pLmFree(p);
1670          v->rtyp = NUMBER_CMD;
1671          v->name = id;
1672          return;
1673        }
1674      }
1675    }
1676    /* 5. existing identifier, global */
1677    if (h!=NULL)
1678    {
1679      if (id!=IDID(h)) omFreeBinAddr((ADDRESS)id);  /*assume strlen(id) <1000 */
1680      goto id_found;
1681    }
1682    /* 6. local ring: number/poly */
1683    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1684    {
1685      BOOLEAN ok=FALSE;
1686      /*poly p = (!yyInRingConstruction) ? pmInit(id,ok) : (poly)NULL;*/
1687      poly p = pmInit(id,ok);
1688      if (ok)
1689      {
1690        if (p==NULL)
1691        {
1692          v->data = (void *)nInit(0);
1693          v->rtyp = NUMBER_CMD;
1694          #ifdef HAVE_PLURAL
1695          // in this case we may have monomials equal to 0 in p_Read
1696          v->name = id;
1697          #else
1698          omFreeBinAddr((ADDRESS)id);
1699          #endif
1700        }
1701        else if (pIsConstant(p))
1702        {
1703          v->data = pGetCoeff(p);
1704          pGetCoeff(p)=NULL;
1705          pLmFree(p);
1706          v->rtyp = NUMBER_CMD;
1707          v->name = id;
1708        }
1709        else
1710        {
1711          v->name = id;
1712        #ifdef HAVE_SHIFTBBA
1713          if ((currRing->isLPring!=0)
1714          && (p_Totaldegree(p,currRing)>1))
1715          {
1716            p_LmDelete(&p,currRing);
1717            /* v->rtyp = UNKNOWN; - already set */
1718            return; /* error, report "unknown id" */
1719          }
1720        #endif
1721          v->data = p;
1722          v->rtyp = POLY_CMD;
1723        }
1724        return;
1725      }
1726    }
1727    /* 7. non-local ring: number/poly */
1728    {
1729      BOOLEAN ok=FALSE;
1730      poly p = ((currRing!=NULL)     /* ring required */
1731               && (currRingHdl!=NULL)
1732               /*&& (!yyInRingConstruction) - not in decl */
1733               && (IDLEV(currRingHdl)!=myynest)) /* already in case 4/6 */
1734                     ? pmInit(id,ok) : (poly)NULL;
1735      if (ok)
1736      {
1737        if (p==NULL)
1738        {
1739          v->data = (void *)nInit(0);
1740          v->rtyp = NUMBER_CMD;
1741          omFreeBinAddr((ADDRESS)id);
1742        }
1743        else
1744        if (pIsConstant(p))
1745        {
1746          v->data = pGetCoeff(p);
1747          pGetCoeff(p)=NULL;
1748          pLmFree(p);
1749          v->rtyp = NUMBER_CMD;
1750          v->name = id;
1751        }
1752        else
1753        {
1754          v->data = p;
1755          v->rtyp = POLY_CMD;
1756          v->name = id;
1757        }
1758        //if (TEST_V_ALLWARN /*&& (myynest>0)*/
1759        //&& ((r_IsRingVar(id, currRing->names,currRing->N)>=0)
1760        //  || ((n_NumberOfParameters(currRing->cf)>0)
1761        //     &&(r_IsRingVar(id, (char**)n_ParameterNames(currRing->cf),
1762        //                        n_NumberOfParameters(currRing->cf))>=0))))
1763        //{
1764        //// WARNING: do not use ring variable names in procedures
1765        //  Warn("use of variable >>%s<< in a procedure in line %s",id,my_yylinebuf);
1766        //}
1767        return;
1768      }
1769    }
1770    /* 8. basering ? */
1771    if ((myynest>1)&&(currRingHdl!=NULL))
1772    {
1773      if (strcmp(id,IDID(currRingHdl))==0)
1774      {
1775        if (IDID(currRingHdl)!=id) omFreeBinAddr((ADDRESS)id); /*assume strlen (id) <1000 */
1776        h=currRingHdl;
1777        goto id_found;
1778      }
1779    }
1780    if((v->req_packhdl!=basePack) && (v->req_packhdl==currPack))
1781    {
1782      h=basePack->idroot->get(id,myynest);
1783      if (h!=NULL)
1784      {
1785        if (id!=IDID(h)) omFreeBinAddr((ADDRESS)id); /*assume strlen(id) <1000 */
1786        v->req_packhdl=basePack;
1787        goto id_found;
1788      }
1789    }
1790  }
1791#ifdef SIQ
1792  else
1793    v->rtyp=DEF_CMD;
1794#endif
1795  /* 9: _ */
1796  if (strcmp(id,"_")==0)
1797  {
1798    omFreeBinAddr((ADDRESS)id);
1799    v->Copy(&sLastPrinted);
1800  }
1801  else
1802  {
1803    /* 10: everything else */
1804    /* v->rtyp = UNKNOWN;*/
1805    v->name = id;
1806  }
1807  currRingHdl=save_ring;
1808  return;
1809id_found: // we have an id (in h) found, to set the data in from h
1810  if (IDTYP(h)!=ALIAS_CMD)
1811  {
1812    v->rtyp = IDHDL;
1813    v->flag = IDFLAG(h);
1814    v->attribute=IDATTR(h);
1815  }
1816  else
1817  {
1818    v->rtyp = ALIAS_CMD;
1819  }
1820  v->name = IDID(h);
1821  v->data = (char *)h;
1822  currRingHdl=save_ring;
1823}
1824
1825void syMakeMonom(leftv v,const char * id)
1826{
1827  if (!isdigit(id[0]))
1828  {
1829    Print("non-digit:%s\n",id);
1830  }
1831  /* resolv an identifier: (to DEF_CMD, if siq>0)
1832  * 6) monom (resp. number), local ring
1833  * 7) monom (resp. number), non-local ring
1834  * 10) everything else is of type 0
1835  */
1836#ifdef TEST
1837  if ((*id<' ')||(*id>(char)126))
1838  {
1839    Print("wrong id :%s:\n",id);
1840  }
1841#endif
1842  idhdl save_ring=currRingHdl;
1843  v->Init();
1844  v->req_packhdl = currPack;
1845#ifdef SIQ
1846  if (siq<=0)
1847#endif
1848  {
1849    /* 6. local ring: number/poly */
1850    BOOLEAN ok=FALSE;
1851    poly p = pmInit(id,ok);
1852    if (ok)
1853    {
1854      if (p==NULL)
1855      {
1856        v->data = (void *)nInit(0);
1857        v->rtyp = NUMBER_CMD;
1858        #ifdef HAVE_PLURAL
1859        // in this case we may have monomials equal to 0 in p_Read
1860        if (rIsPluralRing(currRing)) v->name = omStrDup(id);
1861        #endif
1862      }
1863      else if (pIsConstant(p))
1864      {
1865        v->data = pGetCoeff(p);
1866        pGetCoeff(p)=NULL;
1867        pLmFree(p);
1868        v->rtyp = NUMBER_CMD;
1869      }
1870      else
1871      {
1872        v->name = omStrDup(id);
1873        #ifdef HAVE_SHIFTBBA
1874        if ((currRing->isLPring!=0)
1875        && (p_Totaldegree(p,currRing)>1))
1876        {
1877          p_LmDelete(&p,currRing);
1878          /* v->rtyp = UNKNOWN; - already set */
1879          return; /* error, report "unknown id" */
1880        }
1881        #endif
1882        v->data = p;
1883        v->rtyp = POLY_CMD;
1884      }
1885      return;
1886    }
1887  }
1888#ifdef SIQ
1889  else
1890  {
1891    v->rtyp=DEF_CMD;
1892  }
1893#endif
1894  /* 9: _ */
1895  if (strcmp(id,"_")==0)
1896  {
1897    v->Copy(&sLastPrinted);
1898  }
1899  else
1900  {
1901    /* 10: everything else */
1902    /* v->rtyp = UNKNOWN;*/
1903    v->name = omStrDup(id);
1904  }
1905  currRingHdl=save_ring;
1906}
1907
1908int sleftv::Eval()
1909{
1910  BOOLEAN nok=FALSE;
1911  leftv nn=next;
1912  next=NULL;
1913  if(rtyp==IDHDL)
1914  {
1915    int t=Typ();
1916    if (t!=PROC_CMD)
1917    {
1918      void *d=CopyD(t);
1919      data=d;
1920      rtyp=t;
1921      name=NULL;
1922      e=NULL;
1923    }
1924  }
1925  else if (rtyp==COMMAND)
1926  {
1927    command d=(command)data;
1928    if(d->op==PROC_CMD) //assume d->argc==2
1929    {
1930      char *what=(char *)(d->arg1.Data());
1931      idhdl h=ggetid(what);
1932      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1933      {
1934        nok=d->arg2.Eval();
1935        if(!nok)
1936        {
1937          nok=iiMake_proc(h,req_packhdl,&d->arg2);
1938          this->CleanUp(currRing);
1939          if (!nok)
1940          {
1941            memcpy(this,&iiRETURNEXPR,sizeof(sleftv));
1942            iiRETURNEXPR.Init();
1943          }
1944        }
1945      }
1946      else nok=TRUE;
1947    }
1948    else if (d->op=='=') //assume d->argc==2
1949    {
1950      if ((d->arg1.rtyp!=IDHDL)&&(d->arg1.rtyp!=DEF_CMD))
1951      {
1952        nok=d->arg1.Eval();
1953      }
1954      if (!nok)
1955      {
1956        const char *n=d->arg1.name;
1957        nok=(n == NULL) || d->arg2.Eval();
1958        if (!nok)
1959        {
1960          int save_typ=d->arg1.rtyp;
1961          omCheckAddr((ADDRESS)n);
1962          if (d->arg1.rtyp!=IDHDL)
1963          syMake(&d->arg1,n);
1964          omCheckAddr((ADDRESS)d->arg1.name);
1965          if (d->arg1.rtyp==IDHDL)
1966          {
1967            n=omStrDup(IDID((idhdl)d->arg1.data));
1968            killhdl((idhdl)d->arg1.data);
1969            d->arg1.Init();
1970            //d->arg1.data=NULL;
1971            d->arg1.name=n;
1972          }
1973          d->arg1.rtyp=DEF_CMD;
1974          sleftv t;
1975          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1976          if (::RingDependend(d->arg2.rtyp))
1977            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1978          else
1979            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&IDROOT);
1980          memcpy(&d->arg1,&t,sizeof(sleftv));
1981          omCheckAddr((ADDRESS)d->arg1.name);
1982          nok=nok||iiAssign(&d->arg1,&d->arg2);
1983          omCheckIf(d->arg1.name != NULL,  // OB: ????
1984                    omCheckAddr((ADDRESS)d->arg1.name));
1985          if (!nok)
1986          {
1987            d->arg1.Init();
1988            this->CleanUp();
1989            rtyp=NONE;
1990          }
1991        }
1992      }
1993      else nok=TRUE;
1994    }
1995    else
1996    {
1997      sleftv tmp; tmp.Init();
1998      int toktype=iiTokType(d->op);
1999      if ((toktype==CMD_M)
2000      ||( toktype==ROOT_DECL_LIST)
2001      ||( toktype==RING_DECL_LIST))
2002      {
2003        if (d->argc <=3)
2004        {
2005          if (d->argc>=1) nok=d->arg1.Eval();
2006          if ((!nok) && (d->argc>=2))
2007          {
2008            nok=d->arg2.Eval();
2009            d->arg1.next=(leftv)omAllocBin(sleftv_bin);
2010            memcpy(d->arg1.next,&d->arg2,sizeof(sleftv));
2011            d->arg2.Init();
2012          }
2013          if ((!nok) && (d->argc==3))
2014          {
2015            nok=d->arg3.Eval();
2016            d->arg1.next->next=(leftv)omAllocBin(sleftv_bin);
2017            memcpy(d->arg1.next->next,&d->arg3,sizeof(sleftv));
2018            d->arg3.Init();
2019          }
2020          if (d->argc==0)
2021            nok=nok||iiExprArithM(&tmp,NULL,d->op);
2022          else
2023            nok=nok||iiExprArithM(&tmp,&d->arg1,d->op);
2024        }
2025        else
2026        {
2027          nok=d->arg1.Eval();
2028          nok=nok||iiExprArithM(&tmp,&d->arg1,d->op);
2029        }
2030      }
2031      else if (d->argc==1)
2032      {
2033        nok=d->arg1.Eval();
2034        nok=nok||iiExprArith1(&tmp,&d->arg1,d->op);
2035      }
2036      else if(d->argc==2)
2037      {
2038        nok=d->arg1.Eval();
2039        nok=nok||d->arg2.Eval();
2040        nok=nok||iiExprArith2(&tmp,&d->arg1,d->op,&d->arg2);
2041      }
2042      else if(d->argc==3)
2043      {
2044        nok=d->arg1.Eval();
2045        nok=nok||d->arg2.Eval();
2046        nok=nok||d->arg3.Eval();
2047        nok=nok||iiExprArith3(&tmp,d->op,&d->arg1,&d->arg2,&d->arg3);
2048      }
2049      else if(d->argc!=0)
2050      {
2051        nok=d->arg1.Eval();
2052        nok=nok||iiExprArithM(&tmp,&d->arg1,d->op);
2053      }
2054      else // d->argc == 0
2055      {
2056        nok = iiExprArithM(&tmp, NULL, d->op);
2057      }
2058      this->CleanUp();
2059      memcpy(this,&tmp,sizeof(tmp));
2060    }
2061  }
2062  else if (((rtyp==0)||(rtyp==DEF_CMD))
2063    &&(name!=NULL))
2064  {
2065     syMake(this,name);
2066  }
2067#ifdef MDEBUG
2068  switch(Typ())
2069  {
2070    case NUMBER_CMD:
2071#ifdef LDEBUG
2072      nTest((number)Data());
2073#endif
2074      break;
2075    case BIGINT_CMD:
2076#ifdef LDEBUG
2077      n_Test((number)Data(),coeffs_BIGINT);
2078#endif
2079      break;
2080    case POLY_CMD:
2081      pTest((poly)Data());
2082      break;
2083    case IDEAL_CMD:
2084    case MODUL_CMD:
2085    case MATRIX_CMD:
2086      {
2087        ideal id=(ideal)Data();
2088        omCheckAddrSize(id,sizeof(*id));
2089        int i=id->ncols*id->nrows-1;
2090        for(;i>=0;i--) pTest(id->m[i]);
2091      }
2092      break;
2093  }
2094#endif
2095  if (nn!=NULL) nok=nok||nn->Eval();
2096  next=nn;
2097  return nok;
2098}
2099
2100void * sattr::CopyA()
2101{
2102  omCheckAddrSize(this,sizeof(sattr));
2103  return s_internalCopy(atyp,data);
2104}
2105
Note: See TracBrowser for help on using the repository browser.