source: git/Singular/subexpr.cc @ f7c78e2

spielwiese
Last change on this file since f7c78e2 was f7c78e2, checked in by Hans Schoenemann <hannes@…>, 5 years ago
fix: read number in LP ring
  • Property mode set to 100644
File size: 48.0 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
40omBin sSubexpr_bin = omGetSpecBin(sizeof(_ssubexpr));
41omBin sleftv_bin = omGetSpecBin(sizeof(sleftv));
42omBin procinfo_bin = omGetSpecBin(sizeof(procinfo));
43omBin libstack_bin = omGetSpecBin(sizeof(libstack));
44static omBin size_two_bin = omGetSpecBin(2);
45
46sleftv     sLastPrinted;
47#ifdef SIQ
48BOOLEAN 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              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 = (const 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            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("%d",(int)(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          r->ref++;
487          //Print("s_internalCopy:+  ring %d, 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 * slInternalCopy(leftv source, const int t, void *d, Subexpr e)
686{
687  if (t==STRING_CMD)
688  {
689      if ((e==NULL)
690      || (source->rtyp==LIST_CMD)
691      || ((source->rtyp==IDHDL)
692          &&((IDTYP((idhdl)source->data)==LIST_CMD)
693            || (IDTYP((idhdl)source->data)>MAX_TOK)))
694      || (source->rtyp>MAX_TOK))
695        return (void *)omStrDup((char *)d);
696      else if (e->next==NULL)
697      {
698        char *s=(char*)omAllocBin(size_two_bin);
699        s[0]=*(char *)d;
700        s[1]='\0';
701        return s;
702      }
703      #ifdef TEST
704      else
705      {
706        Werror("not impl. string-op in `%s`",my_yylinebuf);
707        return NULL;
708      }
709      #endif
710  }
711  return s_internalCopy(t,d);
712}
713
714void sleftv::Copy(leftv source)
715{
716  Init();
717  rtyp=source->Typ();
718  void *d=source->Data();
719  if(!errorreported)
720  {
721    if (rtyp==BUCKET_CMD)
722    {
723      rtyp=POLY_CMD;
724      data=(void*)pCopy(sBucketPeek((sBucket_pt)d));
725    }
726    else
727      data=s_internalCopy(rtyp,d);
728    if ((source->attribute!=NULL)||(source->e!=NULL))
729      attribute=source->CopyA();
730    flag=source->flag;
731    if (source->next!=NULL)
732    {
733      next=(leftv)omAllocBin(sleftv_bin);
734      next->Copy(source->next);
735    }
736  }
737}
738
739void * sleftv::CopyD(int t)
740{
741  if ((rtyp!=IDHDL)&&(rtyp!=ALIAS_CMD)&&(e==NULL))
742  {
743    if (iiCheckRing(t)) return NULL;
744    void *x = data;
745    if (rtyp==VNOETHER) x = (void *)pCopy((currRing->ppNoether));
746    else if ((rtyp==VMINPOLY) && nCoeff_is_algExt(currRing->cf) && (!nCoeff_is_GF(currRing->cf)))
747    {
748      const ring A = currRing->cf->extRing;
749
750      assume( A != NULL );
751      assume( A->qideal != NULL );
752
753      x=(void *)p_Copy(A->qideal->m[0], A);
754    }
755    data=NULL;
756    return x;
757  }
758  void *d=Data(); // will also do a iiCheckRing
759  if ((!errorreported) && (d!=NULL)) return slInternalCopy(this,t,d,e);
760  return NULL;
761}
762
763//void * sleftv::CopyD()
764//{
765  //if ((rtyp!=IDHDL)&&(e==NULL)
766  //&&(rtyp!=VNOETHER)&&(rtyp!=VMINPOLY))
767  //{
768  //  void *x=data;
769  //  data=NULL;
770  //  return x;
771  //}
772//  return CopyD(Typ());
773//}
774
775attr sleftv::CopyA()
776{
777  attr *a=Attribute();
778  if ((a!=NULL) && (*a!=NULL))
779    return (*a)->Copy();
780  return NULL;
781}
782
783char *  sleftv::String(void *d, BOOLEAN typed, int dim)
784{
785#ifdef SIQ
786  if (rtyp==COMMAND)
787  {
788    ::Print("##command %d\n",((command)data)->op);
789    if (((command)data)->arg1.rtyp!=0)
790      ((command)data)->arg1.Print(NULL,2);
791    if (((command)data)->arg2.rtyp!=0)
792      ((command)data)->arg2.Print(NULL,2);
793    if (((command)data)->arg3.rtyp==0)
794      ((command)data)->arg3.Print(NULL,2);
795    PrintS("##end\n");
796    return omStrDup("");
797  }
798#endif
799  if (d==NULL) d=Data();
800  if (!errorreported)
801  {
802    char *s;
803    int t=Typ();
804    switch (t /*Typ()*/)
805    {
806        case INT_CMD:
807          if (typed)
808          {
809            s=(char *)omAlloc(MAX_INT_LEN+7);
810            sprintf(s,"int(%d)",(int)(long)d);
811          }
812          else
813          {
814            s=(char *)omAlloc(MAX_INT_LEN+2);
815            sprintf(s,"%d",(int)(long)d);
816          }
817          return s;
818
819        case STRING_CMD:
820          if (d == NULL)
821          {
822            if (typed) return omStrDup("\"\"");
823            return omStrDup("");
824          }
825          if (typed)
826          {
827            s = (char*) omAlloc(strlen((char*) d) + 3);
828            sprintf(s,"\"%s\"", (char*) d);
829            return s;
830          }
831          else
832          {
833            return omStrDup((char*)d);
834          }
835
836        case POLY_CMD:
837        case VECTOR_CMD:
838          if (typed)
839          {
840            char* ps = pString((poly) d);
841            s = (char*) omAlloc(strlen(ps) + 10);
842            sprintf(s,"%s(%s)", (t /*Typ()*/ == POLY_CMD ? "poly" : "vector"), ps);
843            omFree(ps);
844            return s;
845          }
846          else
847            return pString((poly)d);
848
849        case CRING_CMD:
850          return nCoeffString((coeffs)d);
851        #ifdef SINGULAR_4_2
852        case CNUMBER_CMD:
853          return n2String((number2)d,typed);
854        case CMATRIX_CMD:
855          {
856            bigintmat *b=(bigintmat*)d;
857            return b->String();
858          }
859        #endif
860
861        case NUMBER_CMD:
862          StringSetS((char*) (typed ? "number(" : ""));
863          if((rtyp==VMINPOLY)&&(rField_is_GF(currRing)))
864          {
865            nfShowMipo(currRing->cf);
866          }
867          else
868          {
869            nWrite((number)d);
870          }
871          StringAppendS((char*) (typed ? ")" : ""));
872          return StringEndS();
873
874        case BIGINT_CMD:
875          {
876          StringSetS((char*) (typed ? "bigint(" : ""));
877          number nl=(number)d;
878          n_Write(nl,coeffs_BIGINT);
879          StringAppendS((char*) (typed ? ")" : ""));
880          return StringEndS();
881          }
882        case BUCKET_CMD:
883          return sBucketString((sBucket_pt)d);
884        case MATRIX_CMD:
885          s= iiStringMatrix((matrix)d,dim, currRing);
886          if (typed)
887          {
888            char* ns = (char*) omAlloc(strlen(s) + 40);
889            sprintf(ns, "matrix(ideal(%s),%d,%d)", s,
890                    ((ideal) d)->nrows, ((ideal) d)->ncols);
891            omCheckAddr(ns);
892            return ns;
893          }
894          else
895          {
896            return omStrDup(s);
897          }
898
899        case IDEAL_CMD:
900        case MAP_CMD:
901        case MODUL_CMD:
902        case SMATRIX_CMD:
903          s= iiStringMatrix((matrix)d,dim, currRing);
904          if (typed)
905          {
906            char* ns = (char*) omAlloc(strlen(s) + 10);
907            if ((t/*Typ()*/==IDEAL_CMD)||(t==MAP_CMD))
908              sprintf(ns, "ideal(%s)", s);
909            else /*MODUL_CMD, SMATRIX_CMD */
910              sprintf(ns, "module(%s)", s);
911            omFree(s);
912            omCheckAddr(ns);
913            return ns;
914          }
915          return s;
916
917        case INTVEC_CMD:
918        case INTMAT_CMD:
919        {
920          intvec *v=(intvec *)d;
921          s = v->String(dim);
922          if (typed)
923          {
924            char* ns;
925            if (t/*Typ()*/ == INTMAT_CMD)
926            {
927              ns = (char*) omAlloc(strlen(s) + 40);
928              sprintf(ns, "intmat(intvec(%s),%d,%d)", s, v->rows(), v->cols());
929            }
930            else
931            {
932              ns = (char*) omAlloc(strlen(s) + 10);
933              sprintf(ns, "intvec(%s)", s);
934            }
935            omCheckAddr(ns);
936            omFree(s);
937            return ns;
938          }
939          else
940            return s;
941        }
942        case BIGINTMAT_CMD:
943        {
944          bigintmat *bim=(bigintmat*)d;
945          s = bim->String();
946          if (typed)
947          {
948            char* ns = (char*) omAlloc0(strlen(s) + 40);
949            sprintf(ns, "bigintmat(bigintvec(%s),%d,%d)", s, bim->rows(), bim->cols());
950            omCheckAddr(ns);
951            return ns;
952          }
953          else
954            return omStrDup(s);
955        }
956
957        case RING_CMD:
958          s  = rString((ring)d);
959
960          if (typed)
961          {
962            char* ns;
963            ring r=(ring)d;
964            if (r->qideal!=NULL)
965            {
966              char* id = iiStringMatrix((matrix) ((ring) d)->qideal, dim,
967                              currRing);
968              ns = (char*) omAlloc(strlen(s) + strlen(id) + 20);
969              sprintf(ns, "\"%s\";%sideal(%s)", s,(dim == 2 ? "\n" : " "), id);
970            }
971            else
972            {
973              ns = (char*) omAlloc(strlen(s) + 4);
974              sprintf(ns, "\"%s\"", s);
975            }
976            omFree(s);
977            omCheckAddr(ns);
978            return ns;
979          }
980          return s;
981        case RESOLUTION_CMD:
982        {
983          lists l = syConvRes((syStrategy)d);
984          s = lString(l, typed, dim);
985          l->Clean();
986          return s;
987        }
988
989        case PROC_CMD:
990        {
991          procinfo* pi = (procinfo*) d;
992          if((pi->language == LANG_SINGULAR) && (pi->data.s.body!=NULL))
993            s = (pi->data.s.body);
994          else
995            s = (char *)"";
996          if (typed)
997          {
998            char* ns = (char*) omAlloc(strlen(s) + 4);
999            sprintf(ns, "\"%s\"", s);
1000            omCheckAddr(ns);
1001            return ns;
1002          }
1003          return omStrDup(s);
1004        }
1005
1006        case LINK_CMD:
1007          s = slString((si_link) d);
1008          if (typed)
1009          {
1010            char* ns = (char*) omAlloc(strlen(s) + 10);
1011            sprintf(ns, "link(\"%s\")", s);
1012            omFreeBinAddr(s);
1013            omCheckAddr(ns);
1014            return ns;
1015          }
1016          return s;
1017
1018        case LIST_CMD:
1019          return lString((lists) d, typed, dim);
1020
1021        default:
1022          if(t> MAX_TOK)
1023          {
1024            blackbox *bb=getBlackboxStuff(t);
1025            if (bb!=NULL) return bb->blackbox_String(bb,d);
1026          }
1027    } /* end switch: (Typ()) */
1028  }
1029  return omStrDup("");
1030}
1031
1032
1033int  sleftv::Typ()
1034{
1035  if (e==NULL)
1036  {
1037    switch (rtyp)
1038    {
1039      case IDHDL:
1040        return IDTYP((idhdl)data);
1041      case ALIAS_CMD:
1042         {
1043           idhdl h=(idhdl)data;
1044           return  ((idhdl)h->data.ustring)->typ;
1045         }
1046      case VECHO:
1047      case VPRINTLEVEL:
1048      case VCOLMAX:
1049      case VTIMER:
1050      case VRTIMER:
1051      case VOICE:
1052      case VMAXDEG:
1053      case VMAXMULT:
1054      case TRACE:
1055      case VSHORTOUT:
1056        return INT_CMD;
1057      case VMINPOLY:
1058        data=NULL;
1059        return NUMBER_CMD;
1060      case VNOETHER:
1061        data=NULL;
1062        return POLY_CMD;
1063      //case COMMAND:
1064      //  return COMMAND;
1065      default:
1066        return rtyp;
1067    }
1068  }
1069  int r=0;
1070  int t=rtyp;
1071  void *d=data;
1072  if (t==IDHDL) t=IDTYP((idhdl)d);
1073  else if (t==ALIAS_CMD)
1074  { idhdl h=(idhdl)IDDATA((idhdl)data); t=IDTYP(h);d=IDDATA(h); }
1075  switch (t)
1076  {
1077#ifdef SINGULAR_4_2
1078    case CMATRIX_CMD:
1079    {
1080      bigintmat *b=(bigintmat*)d;
1081      if ((currRing!=NULL)&&(currRing->cf==b->basecoeffs()))
1082        return NUMBER_CMD;
1083      else
1084        return CNUMBER_CMD;
1085    }
1086#endif
1087    case INTVEC_CMD:
1088    case INTMAT_CMD:
1089      r=INT_CMD;
1090      break;
1091    case BIGINTMAT_CMD:
1092      r=BIGINT_CMD;
1093      break;
1094    case IDEAL_CMD:
1095    case MATRIX_CMD:
1096    case MAP_CMD:
1097    case SMATRIX_CMD:
1098      r=POLY_CMD;
1099      break;
1100    case MODUL_CMD:
1101      r=VECTOR_CMD;
1102      break;
1103    case STRING_CMD:
1104      r=STRING_CMD;
1105      break;
1106    default:
1107    {
1108      blackbox *b=NULL;
1109      if (t>MAX_TOK)
1110      {
1111        b=getBlackboxStuff(t);
1112      }
1113      if ((t==LIST_CMD)||((b!=NULL)&&BB_LIKE_LIST(b)))
1114      {
1115        lists l;
1116        if (rtyp==IDHDL) l=IDLIST((idhdl)d);
1117        else             l=(lists)d;
1118        if ((0<e->start)&&(e->start<=l->nr+1))
1119        {
1120          Subexpr tmp=l->m[e->start-1].e;
1121          l->m[e->start-1].e=e->next;
1122          r=l->m[e->start-1].Typ();
1123          e->next=l->m[e->start-1].e;
1124          l->m[e->start-1].e=tmp;
1125        }
1126        else
1127        {
1128          //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
1129          r=DEF_CMD;
1130        }
1131      }
1132      else
1133        Werror("cannot index type %s(%d)",Tok2Cmdname(t),t);
1134      break;
1135    }
1136  }
1137  return r;
1138}
1139
1140int  sleftv::LTyp()
1141{
1142  lists l=NULL;
1143  int r;
1144  if (rtyp==LIST_CMD)
1145    l=(lists)data;
1146  else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1147    l=IDLIST((idhdl)data);
1148  else
1149    return Typ();
1150  //if (l!=NULL)
1151  {
1152    if ((e!=NULL) && (e->next!=NULL))
1153    {
1154      if ((0<e->start)&&(e->start<=l->nr+1))
1155      {
1156        l->m[e->start-1].e=e->next;
1157        r=l->m[e->start-1].LTyp();
1158        l->m[e->start-1].e=NULL;
1159      }
1160      else
1161      {
1162        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
1163        r=NONE;
1164      }
1165      return r;
1166    }
1167    return LIST_CMD;
1168  }
1169  return Typ();
1170}
1171
1172#ifdef SINGULAR_4_2
1173static snumber2 iiNumber2Data[4];
1174static int iiCmatrix_index=0;
1175#endif
1176void * sleftv::Data()
1177{
1178  if ((rtyp!=IDHDL) && iiCheckRing(rtyp))
1179     return NULL;
1180  if (e==NULL)
1181  {
1182    switch (rtyp)
1183    {
1184      case ALIAS_CMD:
1185      {
1186        idhdl h=(idhdl)data;
1187        return  ((idhdl)h->data.ustring)->data.ustring;
1188      }
1189      case VECHO:      return (void *)(long)si_echo;
1190      case VPRINTLEVEL:return (void *)(long)printlevel;
1191      case VCOLMAX:    return (void *)(long)colmax;
1192      case VTIMER:     return (void *)(long)getTimer();
1193      case VRTIMER:    return (void *)(long)getRTimer();
1194      case VOICE:      return (void *)(long)(myynest+1);
1195      case VMAXDEG:    return (void *)(long)Kstd1_deg;
1196      case VMAXMULT:   return (void *)(long)Kstd1_mu;
1197      case TRACE:      return (void *)(long)traceit;
1198      case VSHORTOUT:  return (void *)(long)(currRing != NULL ? currRing->ShortOut : 0);
1199      case VMINPOLY:
1200        if ( (currRing != NULL)  && nCoeff_is_algExt(currRing->cf) && !nCoeff_is_GF(currRing->cf))
1201        {
1202          /* Q(a), Fp(a), but not GF(q) */
1203          const ring A = currRing->cf->extRing;
1204
1205          assume( A != NULL );
1206          assume( A->qideal != NULL );
1207
1208          return (void *)A->qideal->m[0];
1209        }
1210        else
1211          return (void *)nInit(0);
1212
1213      case VNOETHER:   return (void *) (currRing->ppNoether);
1214      case IDHDL:
1215        return IDDATA((idhdl)data);
1216      case COMMAND:
1217        //return NULL;
1218      default:
1219        return data;
1220    }
1221  }
1222  /* e != NULL : */
1223  int t=rtyp;
1224  void *d=data;
1225  if (t==IDHDL)
1226  {
1227    t=((idhdl)data)->typ;
1228    d=IDDATA((idhdl)data);
1229  }
1230  else if (t==ALIAS_CMD)
1231  {
1232    idhdl h=(idhdl)IDDATA((idhdl)data);
1233    t=IDTYP(h);
1234    d=IDDATA(h);
1235  }
1236  if (iiCheckRing(t))
1237    return NULL;
1238  char *r=NULL;
1239  int index=e->start;
1240  switch (t)
1241  {
1242    case INTVEC_CMD:
1243    {
1244      intvec *iv=(intvec *)d;
1245      if ((index<1)||(index>iv->length()))
1246      {
1247        if (!errorreported)
1248          Werror("wrong range[%d] in intvec %s(%d)",index,this->Name(),iv->length());
1249      }
1250      else
1251        r=(char *)(long)((*iv)[index-1]);
1252      break;
1253    }
1254    case INTMAT_CMD:
1255    {
1256      intvec *iv=(intvec *)d;
1257      if ((index<1)
1258         ||(index>iv->rows())
1259         ||(e->next->start<1)
1260         ||(e->next->start>iv->cols()))
1261      {
1262        if (!errorreported)
1263        Werror("wrong range[%d,%d] in intmat %s(%dx%d)",index,e->next->start,
1264                                           this->Name(),iv->rows(),iv->cols());
1265      }
1266      else
1267        r=(char *)(long)(IMATELEM((*iv),index,e->next->start));
1268      break;
1269    }
1270    case BIGINTMAT_CMD:
1271    {
1272      bigintmat *m=(bigintmat *)d;
1273      if ((index<1)
1274         ||(index>m->rows())
1275         ||(e->next->start<1)
1276         ||(e->next->start>m->cols()))
1277      {
1278        if (!errorreported)
1279        Werror("wrong range[%d,%d] in bigintmat %s(%dx%d)",index,e->next->start,
1280                                                     this->Name(),m->rows(),m->cols());
1281      }
1282      else
1283        r=(char *)(BIMATELEM((*m),index,e->next->start));
1284      break;
1285    }
1286#ifdef SINGULAR_4_2
1287    case CMATRIX_CMD:
1288    {
1289      bigintmat *m=(bigintmat *)d;
1290      if ((index<1)
1291         ||(index>m->rows())
1292         ||(e->next->start<1)
1293         ||(e->next->start>m->cols()))
1294      {
1295        if (!errorreported)
1296        Werror("wrong range[%d,%d] in matrix %s(%dx%d)",index,e->next->start,
1297                                                     this->Name(),m->rows(),m->cols());
1298      }
1299      else
1300      {
1301        iiNumber2Data[iiCmatrix_index].cf=m->basecoeffs();
1302        iiNumber2Data[iiCmatrix_index].n=BIMATELEM((*m),index,e->next->start);
1303        r=(char*)&iiNumber2Data[iiCmatrix_index];
1304        iiCmatrix_index=(iiCmatrix_index+1) % 4;
1305      }
1306      break;
1307    }
1308#endif
1309    case IDEAL_CMD:
1310    case MODUL_CMD:
1311    case MAP_CMD:
1312    {
1313      ideal I=(ideal)d;
1314      if ((index<1)||(index>IDELEMS(I)))
1315      {
1316        if (!errorreported)
1317          Werror("wrong range[%d] in ideal/module %s(%d)",index,this->Name(),IDELEMS(I));
1318      }
1319      else
1320        r=(char *)I->m[index-1];
1321      break;
1322    }
1323    case SMATRIX_CMD:
1324    {
1325      ideal I=(ideal)d;
1326      int c;
1327      sleftv tmp;
1328      tmp.Init();
1329      tmp.rtyp=POLY_CMD;
1330      if ((index>0)&& (index<=I->rank)
1331      && (e->next!=NULL)
1332      && ((c=e->next->start)>0) &&(c<=IDELEMS(I)))
1333      {
1334        r=(char*)SMATELEM(I,index-1,c-1,currRing);
1335      }
1336      else
1337      {
1338        r=NULL;
1339      }
1340      tmp.data=r;
1341      if ((rtyp==IDHDL)||(rtyp==SMATRIX_CMD))
1342      {
1343        tmp.next=next; next=NULL;
1344        d=NULL;
1345        CleanUp();
1346        memcpy(this,&tmp,sizeof(tmp));
1347      }
1348      // and, remember, r is also the result...
1349      else
1350      {
1351        // ???
1352        // here we still have a memory leak...
1353        // example: list L="123","456";
1354        // L[1][2];
1355        // therefore, it should never happen:
1356        assume(0);
1357        // but if it happens: here is the temporary fix:
1358        // omMarkAsStaticAddr(r);
1359      }
1360      break;
1361    }
1362    case STRING_CMD:
1363    {
1364      // this was a memory leak
1365      // we evalute it, cleanup and replace this leftv by it's evalutated form
1366      // the evalutated form will be build in tmp
1367      sleftv tmp;
1368      tmp.Init();
1369      tmp.rtyp=STRING_CMD;
1370      r=(char *)omAllocBin(size_two_bin);
1371      if ((index>0)&& (index<=(int)strlen((char *)d)))
1372      {
1373        r[0]=*(((char *)d)+index-1);
1374        r[1]='\0';
1375      }
1376      else
1377      {
1378        r[0]='\0';
1379      }
1380      tmp.data=r;
1381      if ((rtyp==IDHDL)||(rtyp==STRING_CMD))
1382      {
1383        tmp.next=next; next=NULL;
1384        //if (rtyp==STRING_CMD) { omFree((ADDRESS)data); }
1385        //data=NULL;
1386        d=NULL;
1387        CleanUp();
1388        memcpy(this,&tmp,sizeof(tmp));
1389      }
1390      // and, remember, r is also the result...
1391      else
1392      {
1393        // ???
1394        // here we still have a memory leak...
1395        // example: list L="123","456";
1396        // L[1][2];
1397        // therefore, it should never happen:
1398        assume(0);
1399        // but if it happens: here is the temporary fix:
1400        // omMarkAsStaticAddr(r);
1401      }
1402      break;
1403    }
1404    case MATRIX_CMD:
1405    {
1406      if ((index<1)
1407         ||(index>MATROWS((matrix)d))
1408         ||(e->next->start<1)
1409         ||(e->next->start>MATCOLS((matrix)d)))
1410      {
1411        if (!errorreported)
1412          Werror("wrong range[%d,%d] in matrix %s(%dx%d)",
1413                  index,e->next->start,
1414                  this->Name(),
1415                  MATROWS((matrix)d),MATCOLS((matrix)d));
1416      }
1417      else
1418        r=(char *)MATELEM((matrix)d,index,e->next->start);
1419      break;
1420    }
1421    default:
1422    {
1423      blackbox *b=NULL;
1424      if (t>MAX_TOK)
1425      {
1426        b=getBlackboxStuff(t);
1427      }
1428      if ((t==LIST_CMD)||((b!=NULL)&&(BB_LIKE_LIST(b))))
1429      {
1430        lists l=(lists)d;
1431        if ((0<index)&&(index<=l->nr+1))
1432        {
1433          if ((e->next!=NULL)
1434          && (l->m[index-1].rtyp==STRING_CMD))
1435          // string[..].Data() modifies sleftv, so let's do it ourself
1436          {
1437            char *dd=(char *)l->m[index-1].data;
1438            int j=e->next->start-1;
1439            r=(char *)omAllocBin(size_two_bin);
1440            if ((j>=0) && (j<(int)strlen(dd)))
1441            {
1442              r[0]=*(dd+j);
1443              r[1]='\0';
1444            }
1445            else
1446            {
1447              r[0]='\0';
1448            }
1449          }
1450          else
1451          {
1452            Subexpr tmp=l->m[index-1].e;
1453            l->m[index-1].e=e->next;
1454            r=(char *)l->m[index-1].Data();
1455            e->next=l->m[index-1].e;
1456            l->m[index-1].e=tmp;
1457          }
1458        }
1459        else //if (!errorreported)
1460          Werror("wrong range[%d] in list %s(%d)",index,this->Name(),l->nr+1);
1461      }
1462      else
1463        Werror("cannot index %s of type %s(%d)",this->Name(),Tok2Cmdname(t),t);
1464      break;
1465    }
1466  }
1467  return r;
1468}
1469
1470attr * sleftv::Attribute()
1471{
1472  if (e==NULL) return &attribute;
1473  if ((rtyp==LIST_CMD)
1474  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD))
1475  || (rtyp>MAX_TOK)
1476  || ((rtyp==IDHDL)&&(IDTYP((idhdl)data)>MAX_TOK)))
1477  {
1478    leftv v=LData();
1479    return &(v->attribute);
1480  }
1481  return NULL;
1482}
1483
1484leftv sleftv::LData()
1485{
1486  if (e!=NULL)
1487  {
1488    lists l=NULL;
1489    blackbox *b=getBlackboxStuff(rtyp);
1490
1491    if ((rtyp==LIST_CMD)
1492    || ((b!=NULL)&&(BB_LIKE_LIST(b))))
1493      l=(lists)data;
1494    else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1495      l=IDLIST((idhdl)data);
1496    else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)>MAX_TOK))
1497    {
1498      b=getBlackboxStuff(IDTYP((idhdl)data));
1499      if (BB_LIKE_LIST(b)) l=IDLIST((idhdl)data);
1500    }
1501    else if (rtyp==ALIAS_CMD)
1502    {
1503      idhdl h=(idhdl)data;
1504      l= (lists)(((idhdl)h->data.ustring)->data.ustring);
1505    }
1506    if (l!=NULL)
1507    {
1508      if ((0>=e->start)||(e->start>l->nr+1))
1509        return NULL;
1510      if (e->next!=NULL)
1511      {
1512        l->m[e->start-1].e=e->next;
1513        leftv r=l->m[e->start-1].LData();
1514        l->m[e->start-1].e=NULL;
1515        return r;
1516      }
1517      return &(l->m[e->start-1]);
1518    }
1519  }
1520  return this;
1521}
1522
1523#if 0
1524leftv sleftv::LHdl()
1525{
1526  if (e!=NULL)
1527  {
1528    lists l=NULL;
1529
1530    if (rtyp==LIST_CMD)
1531      l=(lists)data;
1532    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1533      l=IDLIST((idhdl)data);
1534    if (l!=NULL)
1535    {
1536      if ((0>=e->start)||(e->start>l->nr+1))
1537        return NULL;
1538      if (e->next!=NULL)
1539      {
1540        l->m[e->start-1].e=e->next;
1541        leftv r=l->m[e->start-1].LHdl();
1542        l->m[e->start-1].e=NULL;
1543        return r;
1544      }
1545      return &(l->m[e->start-1]);
1546    }
1547  }
1548  return this;
1549}
1550#endif
1551
1552BOOLEAN assumeStdFlag(leftv h)
1553{
1554  if (h->e!=NULL)
1555  {
1556    leftv hh=h->LData();
1557    if (h!=hh) return assumeStdFlag(h->LData());
1558  }
1559  if (!hasFlag(h,FLAG_STD))
1560  {
1561    if (!TEST_VERB_NSB)
1562    {
1563      if (TEST_V_ALLWARN)
1564        Warn("%s is no standard basis in >>%s<<",h->Name(),my_yylinebuf);
1565      else
1566        Warn("%s is no standard basis",h->Name());
1567    }
1568    return FALSE;
1569  }
1570  return TRUE;
1571}
1572
1573/*2
1574* transforms a name (as an string created by omAlloc or omStrDup)
1575* into an expression (sleftv), deletes the string
1576* utility for grammar and iparith
1577*/
1578void syMake(leftv v,const char * id, package pa)
1579{
1580  /* resolv an identifier: (to DEF_CMD, if siq>0)
1581  * 1) reserved id: done by scanner
1582  * 2) `basering` / 'Current`
1583  * 3) existing identifier, local
1584  * 4) ringvar, ringpar, local ring
1585  * 5) existing identifier, global
1586  * 6) monom (resp. number), local ring: consisting of:
1587  * 6') ringvar,  ringpar,global ring
1588  * 6'') monom (resp. number), local ring
1589  * 7) monom (resp. number), non-local ring
1590  * 8) basering
1591  * 9) `_`
1592  * 10) everything else is of type 0
1593  */
1594#ifdef TEST
1595  if ((*id<' ')||(*id>(char)126))
1596  {
1597    Print("wrong id :%s:\n",id);
1598  }
1599#endif
1600  idhdl save_ring=currRingHdl;
1601  v->Init();
1602  if(pa != NULL)
1603  {
1604    v->req_packhdl = pa;
1605  }
1606  else v->req_packhdl = currPack;
1607//  if (v->req_packhdl!=basePack)
1608//    Print("search %s in %s\n",id,v->req_packhdl->libname);
1609  idhdl h=NULL;
1610#ifdef SIQ
1611  if (siq<=0)
1612#endif
1613  {
1614    if (!isdigit(id[0]))
1615    {
1616      if (strcmp(id,"basering")==0)
1617      {
1618        if (currRingHdl!=NULL)
1619        {
1620          if (id!=IDID(currRingHdl)) omFreeBinAddr((ADDRESS)id);
1621          h=currRingHdl;
1622          goto id_found;
1623        }
1624        else
1625        {
1626          v->name = id;
1627          return; /* undefined */
1628        }
1629      }
1630      else if (strcmp(id,"Current")==0)
1631      {
1632        if (currPackHdl!=NULL)
1633        {
1634          omFreeBinAddr((ADDRESS)id);
1635          h=currPackHdl;
1636          goto id_found;
1637        }
1638        else
1639        {
1640          v->name = id;
1641          return; /* undefined */
1642        }
1643      }
1644      if(v->req_packhdl!=currPack)
1645      {
1646        h=v->req_packhdl->idroot->get(id,myynest);
1647      }
1648      else
1649      h=ggetid(id);
1650      /* 3) existing identifier, local */
1651      if ((h!=NULL) && (IDLEV(h)==myynest))
1652      {
1653        if (id!=IDID(h)) omFreeBinAddr((ADDRESS)id); /*assume strlen(id) <1000 */
1654        goto id_found;
1655      }
1656    }
1657    if (yyInRingConstruction)
1658    {
1659      currRingHdl=NULL;
1660    }
1661    /* 4. local ring: ringvar */
1662    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest)
1663    /*&& (!yyInRingConstruction)*/)
1664    {
1665      int vnr;
1666      if ((vnr=r_IsRingVar(id, currRing->names,currRing->N))>=0)
1667      {
1668        poly p=pOne();
1669        pSetExp(p,vnr+1,1);
1670        pSetm(p);
1671        v->data = (void *)p;
1672        v->name = id;
1673        v->rtyp = POLY_CMD;
1674        return;
1675      }
1676      if((n_NumberOfParameters(currRing->cf)>0)
1677      &&((vnr=r_IsRingVar(id, (char**)n_ParameterNames(currRing->cf),
1678                              n_NumberOfParameters(currRing->cf))>=0)))
1679      {
1680        BOOLEAN ok=FALSE;
1681        poly p = pmInit(id,ok);
1682        if (ok && (p!=NULL))
1683        {
1684          v->data = pGetCoeff(p);
1685          pGetCoeff(p)=NULL;
1686          pLmFree(p);
1687          v->rtyp = NUMBER_CMD;
1688          v->name = id;
1689          return;
1690        }
1691      }
1692    }
1693    /* 5. existing identifier, global */
1694    if (h!=NULL)
1695    {
1696      if (id!=IDID(h)) omFreeBinAddr((ADDRESS)id);  /*assume strlen(id) <1000 */
1697      goto id_found;
1698    }
1699    /* 6. local ring: number/poly */
1700    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1701    {
1702      BOOLEAN ok=FALSE;
1703      /*poly p = (!yyInRingConstruction) ? pmInit(id,ok) : (poly)NULL;*/
1704      poly p = pmInit(id,ok);
1705      if (ok)
1706      {
1707        if (p==NULL)
1708        {
1709          v->data = (void *)nInit(0);
1710          v->rtyp = NUMBER_CMD;
1711          #ifdef HAVE_PLURAL
1712          // in this case we may have monomials equal to 0 in p_Read
1713          v->name = id;
1714          #else
1715          omFreeBinAddr((ADDRESS)id);
1716          #endif
1717        }
1718        else if (pIsConstant(p))
1719        {
1720          v->data = pGetCoeff(p);
1721          pGetCoeff(p)=NULL;
1722          pLmFree(p);
1723          v->rtyp = NUMBER_CMD;
1724          v->name = id;
1725        }
1726        else
1727        {
1728          v->name = id;
1729        #ifdef HAVE_SHIFTBBA
1730          if ((currRing->isLPring!=0)
1731          && (p_Totaldegree(p,currRing)>1))
1732          {
1733            p_Delete(&p,currRing);
1734            /* v->rtyp = UNKNOWN; - already set */
1735            return; /* error, report "unknown id" */
1736          }
1737        #endif
1738          v->data = p;
1739          v->rtyp = POLY_CMD;
1740        }
1741        return;
1742      }
1743    }
1744    /* 7. non-local ring: number/poly */
1745    {
1746      BOOLEAN ok=FALSE;
1747      poly p = ((currRing!=NULL)     /* ring required */
1748               && (currRingHdl!=NULL)
1749               /*&& (!yyInRingConstruction) - not in decl */
1750               && (IDLEV(currRingHdl)!=myynest)) /* already in case 4/6 */
1751                     ? pmInit(id,ok) : (poly)NULL;
1752      if (ok)
1753      {
1754        if (p==NULL)
1755        {
1756          v->data = (void *)nInit(0);
1757          v->rtyp = NUMBER_CMD;
1758          omFreeBinAddr((ADDRESS)id);
1759        }
1760        else
1761        if (pIsConstant(p))
1762        {
1763          v->data = pGetCoeff(p);
1764          pGetCoeff(p)=NULL;
1765          pLmFree(p);
1766          v->rtyp = NUMBER_CMD;
1767          v->name = id;
1768        }
1769        else
1770        {
1771          v->data = p;
1772          v->rtyp = POLY_CMD;
1773          v->name = id;
1774        }
1775        //if (TEST_V_ALLWARN /*&& (myynest>0)*/
1776        //&& ((r_IsRingVar(id, currRing->names,currRing->N)>=0)
1777        //  || ((n_NumberOfParameters(currRing->cf)>0)
1778        //     &&(r_IsRingVar(id, (char**)n_ParameterNames(currRing->cf),
1779        //                        n_NumberOfParameters(currRing->cf))>=0))))
1780        //{
1781        //// WARNING: do not use ring variable names in procedures
1782        //  Warn("use of variable >>%s<< in a procedure in line %s",id,my_yylinebuf);
1783        //}
1784        return;
1785      }
1786    }
1787    /* 8. basering ? */
1788    if ((myynest>1)&&(currRingHdl!=NULL))
1789    {
1790      if (strcmp(id,IDID(currRingHdl))==0)
1791      {
1792        if (IDID(currRingHdl)!=id) omFreeBinAddr((ADDRESS)id); /*assume strlen (id) <1000 */
1793        h=currRingHdl;
1794        goto id_found;
1795      }
1796    }
1797    if((v->req_packhdl!=basePack) && (v->req_packhdl==currPack))
1798    {
1799      h=basePack->idroot->get(id,myynest);
1800      if (h!=NULL)
1801      {
1802        if (id!=IDID(h)) omFreeBinAddr((ADDRESS)id); /*assume strlen(id) <1000 */
1803        v->req_packhdl=basePack;
1804        goto id_found;
1805      }
1806    }
1807  }
1808#ifdef SIQ
1809  else
1810    v->rtyp=DEF_CMD;
1811#endif
1812  /* 9: _ */
1813  if (strcmp(id,"_")==0)
1814  {
1815    omFreeBinAddr((ADDRESS)id);
1816    v->Copy(&sLastPrinted);
1817  }
1818  else
1819  {
1820    /* 10: everything else */
1821    /* v->rtyp = UNKNOWN;*/
1822    v->name = id;
1823  }
1824  currRingHdl=save_ring;
1825  return;
1826id_found: // we have an id (in h) found, to set the data in from h
1827  if (IDTYP(h)!=ALIAS_CMD)
1828  {
1829    v->rtyp = IDHDL;
1830    v->flag = IDFLAG(h);
1831    v->attribute=IDATTR(h);
1832  }
1833  else
1834  {
1835    v->rtyp = ALIAS_CMD;
1836  }
1837  v->name = IDID(h);
1838  v->data = (char *)h;
1839  currRingHdl=save_ring;
1840}
1841
1842int sleftv::Eval()
1843{
1844  BOOLEAN nok=FALSE;
1845  leftv nn=next;
1846  next=NULL;
1847  if(rtyp==IDHDL)
1848  {
1849    int t=Typ();
1850    if (t!=PROC_CMD)
1851    {
1852      void *d=CopyD(t);
1853      data=d;
1854      rtyp=t;
1855      name=NULL;
1856      e=NULL;
1857    }
1858  }
1859  else if (rtyp==COMMAND)
1860  {
1861    command d=(command)data;
1862    if(d->op==PROC_CMD) //assume d->argc==2
1863    {
1864      char *what=(char *)(d->arg1.Data());
1865      idhdl h=ggetid(what);
1866      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1867      {
1868        nok=d->arg2.Eval();
1869        if(!nok)
1870        {
1871          nok=iiMake_proc(h,req_packhdl,&d->arg2);
1872          this->CleanUp(currRing);
1873          if (!nok)
1874          {
1875            memcpy(this,&iiRETURNEXPR,sizeof(sleftv));
1876            memset(&iiRETURNEXPR,0,sizeof(sleftv));
1877          }
1878        }
1879      }
1880      else nok=TRUE;
1881    }
1882    else if (d->op=='=') //assume d->argc==2
1883    {
1884      if ((d->arg1.rtyp!=IDHDL)&&(d->arg1.rtyp!=DEF_CMD))
1885      {
1886        nok=d->arg1.Eval();
1887      }
1888      if (!nok)
1889      {
1890        const char *n=d->arg1.name;
1891        nok=(n == NULL) || d->arg2.Eval();
1892        if (!nok)
1893        {
1894          int save_typ=d->arg1.rtyp;
1895          omCheckAddr((ADDRESS)n);
1896          if (d->arg1.rtyp!=IDHDL)
1897          syMake(&d->arg1,n);
1898          omCheckAddr((ADDRESS)d->arg1.name);
1899          if (d->arg1.rtyp==IDHDL)
1900          {
1901            n=omStrDup(IDID((idhdl)d->arg1.data));
1902            killhdl((idhdl)d->arg1.data);
1903            d->arg1.Init();
1904            //d->arg1.data=NULL;
1905            d->arg1.name=n;
1906          }
1907          d->arg1.rtyp=DEF_CMD;
1908          sleftv t;
1909          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1910          if (::RingDependend(d->arg2.rtyp))
1911            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1912          else
1913            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&IDROOT);
1914          memcpy(&d->arg1,&t,sizeof(sleftv));
1915          omCheckAddr((ADDRESS)d->arg1.name);
1916          nok=nok||iiAssign(&d->arg1,&d->arg2);
1917          omCheckIf(d->arg1.name != NULL,  // OB: ????
1918                    omCheckAddr((ADDRESS)d->arg1.name));
1919          if (!nok)
1920          {
1921            memset(&d->arg1,0,sizeof(sleftv));
1922            this->CleanUp();
1923            rtyp=NONE;
1924          }
1925        }
1926      }
1927      else nok=TRUE;
1928    }
1929    else
1930    {
1931      sleftv tmp; tmp.Init();
1932      int toktype=iiTokType(d->op);
1933      if ((toktype==CMD_M)
1934      ||( toktype==ROOT_DECL_LIST)
1935      ||( toktype==RING_DECL_LIST))
1936      {
1937        if (d->argc <=3)
1938        {
1939          if (d->argc>=1) nok=d->arg1.Eval();
1940          if ((!nok) && (d->argc>=2))
1941          {
1942            nok=d->arg2.Eval();
1943            d->arg1.next=(leftv)omAllocBin(sleftv_bin);
1944            memcpy(d->arg1.next,&d->arg2,sizeof(sleftv));
1945            d->arg2.Init();
1946          }
1947          if ((!nok) && (d->argc==3))
1948          {
1949            nok=d->arg3.Eval();
1950            d->arg1.next->next=(leftv)omAllocBin(sleftv_bin);
1951            memcpy(d->arg1.next->next,&d->arg3,sizeof(sleftv));
1952            d->arg3.Init();
1953          }
1954          if (d->argc==0)
1955            nok=nok||iiExprArithM(&tmp,NULL,d->op);
1956          else
1957            nok=nok||iiExprArithM(&tmp,&d->arg1,d->op);
1958        }
1959        else
1960        {
1961          nok=d->arg1.Eval();
1962          nok=nok||iiExprArithM(&tmp,&d->arg1,d->op);
1963        }
1964      }
1965      else if (d->argc==1)
1966      {
1967        nok=d->arg1.Eval();
1968        nok=nok||iiExprArith1(&tmp,&d->arg1,d->op);
1969      }
1970      else if(d->argc==2)
1971      {
1972        nok=d->arg1.Eval();
1973        nok=nok||d->arg2.Eval();
1974        nok=nok||iiExprArith2(&tmp,&d->arg1,d->op,&d->arg2);
1975      }
1976      else if(d->argc==3)
1977      {
1978        nok=d->arg1.Eval();
1979        nok=nok||d->arg2.Eval();
1980        nok=nok||d->arg3.Eval();
1981        nok=nok||iiExprArith3(&tmp,d->op,&d->arg1,&d->arg2,&d->arg3);
1982      }
1983      else if(d->argc!=0)
1984      {
1985        nok=d->arg1.Eval();
1986        nok=nok||iiExprArithM(&tmp,&d->arg1,d->op);
1987      }
1988      else // d->argc == 0
1989      {
1990        nok = iiExprArithM(&tmp, NULL, d->op);
1991      }
1992      this->CleanUp();
1993      memcpy(this,&tmp,sizeof(tmp));
1994    }
1995  }
1996  else if (((rtyp==0)||(rtyp==DEF_CMD))
1997    &&(name!=NULL))
1998  {
1999     syMake(this,name);
2000  }
2001#ifdef MDEBUG
2002  switch(Typ())
2003  {
2004    case NUMBER_CMD:
2005#ifdef LDEBUG
2006      nTest((number)Data());
2007#endif
2008      break;
2009    case BIGINT_CMD:
2010#ifdef LDEBUG
2011      n_Test((number)Data(),coeffs_BIGINT);
2012#endif
2013      break;
2014    case POLY_CMD:
2015      pTest((poly)Data());
2016      break;
2017    case IDEAL_CMD:
2018    case MODUL_CMD:
2019    case MATRIX_CMD:
2020      {
2021        ideal id=(ideal)Data();
2022        omCheckAddrSize(id,sizeof(*id));
2023        int i=id->ncols*id->nrows-1;
2024        for(;i>=0;i--) pTest(id->m[i]);
2025      }
2026      break;
2027  }
2028#endif
2029  if (nn!=NULL) nok=nok||nn->Eval();
2030  next=nn;
2031  return nok;
2032}
2033
2034void * sattr::CopyA()
2035{
2036  omCheckAddrSize(this,sizeof(sattr));
2037  return s_internalCopy(atyp,data);
2038}
2039
Note: See TracBrowser for help on using the repository browser.