source: git/Singular/subexpr.cc @ 2ffd25

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