source: git/Singular/subexpr.cc @ eaf66f

spielwiese
Last change on this file since eaf66f was 493225, checked in by Hans Schönemann <hannes@…>, 14 years ago
nWrite indep. from currRing git-svn-id: file:///usr/local/Singular/svn/trunk@12377 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 36.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: handling of leftv
6*/
7/* $Id$ */
8
9#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13#include <unistd.h>
14
15#include "mod2.h"
16#include "intvec.h"
17#include "tok.h"
18#include "ipid.h"
19#include "intvec.h"
20#include <omalloc.h>
21#include "febase.h"
22#include "polys.h"
23#include "ideals.h"
24#include "maps.h"
25#include "matpol.h"
26#include "kstd1.h"
27#include "timer.h"
28#include "ring.h"
29#include "ffields.h"
30#include "numbers.h"
31#include "longrat.h"
32#include "ipshell.h"
33#include "lists.h"
34#include "attrib.h"
35#include "silink.h"
36#include "syz.h"
37#include "attrib.h"
38#include "subexpr.h"
39
40
41omBin sSubexpr_bin = omGetSpecBin(sizeof(sSubexpr));
42omBin sleftv_bin = omGetSpecBin(sizeof(sleftv));
43omBin procinfo_bin = omGetSpecBin(sizeof(procinfo));
44omBin libstack_bin = omGetSpecBin(sizeof(libstack));
45static omBin size_two_bin = omGetSpecBin(2);
46
47sleftv     sLastPrinted;
48const char sNoName[]="_";
49#ifdef SIQ
50BOOLEAN siq=FALSE;
51#endif
52
53void sleftv::Set(int val)
54{
55  Init();
56  rtyp = INT_CMD;
57  data = (void *)val;
58}
59
60int sleftv::listLength()
61{
62  int n = 1;
63  leftv sl = next;
64  while (sl!=NULL)
65  {
66    n++;
67    sl=sl->next;
68  }
69  return n;
70}
71
72void sleftv::Print(leftv store, int spaces)
73{
74  int  t=Typ();
75  if (errorreported) return;
76#ifdef SIQ
77  if (rtyp==COMMAND)
78  {
79    command c=(command)data;
80    char ch[2];
81    ch[0]=c->op;ch[1]='\0';
82    const char *s=ch;
83    if (c->op>127) s=iiTwoOps(c->op);
84    ::Print("##command %d(%s), %d args\n",
85      c->op, s, c->argc);
86    if (c->argc>0)
87      c->arg1.Print(NULL,spaces+2);
88    if(c->argc<4)
89    {
90      if (c->argc>1)
91        c->arg2.Print(NULL,spaces+2);
92      if (c->argc>2)
93        c->arg3.Print(NULL,spaces+2);
94    }
95    PrintS("##end");
96  }
97  else
98#endif
99  {
100    const char *n=Name();
101    char *s;
102    void *d=Data();
103    if (errorreported)
104      return;
105    if ((store!=NULL)&&(store!=this))
106      store->CleanUp();
107
108    switch (t /*=Typ()*/)
109      {
110        case UNKNOWN:
111        case DEF_CMD:
112        case PACKAGE_CMD:
113          PrintNSpaces(spaces);
114          PrintS("`");PrintS(n);PrintS("`");
115          break;
116        case NONE:
117          return;
118        case INTVEC_CMD:
119        case INTMAT_CMD:
120          ((intvec *)d)->show(t,spaces);
121          break;
122        case RING_CMD:
123        case QRING_CMD:
124          PrintNSpaces(spaces);
125          rWrite((ring)d);
126          break;
127        case MATRIX_CMD:
128          iiWriteMatrix((matrix)d,n,2,spaces);
129          break;
130        case MAP_CMD:
131        case MODUL_CMD:
132        case IDEAL_CMD:
133          iiWriteMatrix((matrix)d,n,1,spaces);
134          break;
135        case POLY_CMD:
136        case VECTOR_CMD:
137          PrintNSpaces(spaces);
138          pWrite0((poly)d);
139          break;
140        case RESOLUTION_CMD:
141          syPrint((syStrategy)d);
142          break;
143        case STRING_CMD:
144          PrintNSpaces(spaces);
145          PrintS((char *)d);
146          break;
147       case INT_CMD:
148          PrintNSpaces(spaces);
149          ::Print("%d",(int)(long)d);
150          break;
151       case PROC_CMD:
152         {
153           procinfov pi=(procinfov)d;
154
155           PrintNSpaces(spaces);
156           PrintS("// libname  : ");
157           PrintS(piProcinfo(pi, "libname"));
158           PrintLn();
159
160           PrintNSpaces(spaces);
161           PrintS("// procname : ");
162           PrintS(piProcinfo(pi, "procname"));
163           PrintLn();
164
165           PrintNSpaces(spaces);
166           PrintS("// type     : ");
167           PrintS(piProcinfo(pi, "type"));
168           //           ::Print("%-*.*s// ref      : %s",spaces,spaces," ",
169           //   piProcinfo(pi, "ref"));
170           break;
171         }
172       case POINTER_CMD:
173         { package pack = (package)d;
174         PrintNSpaces(spaces);
175         PrintS("// PointerTest\n");
176         PrintNSpaces(spaces);
177         ::Print("// %s\n",IDID(pack->idroot));
178         //::Print(((char *)(pack->idroot)->data), spaces);
179         break;
180         }
181       case LINK_CMD:
182          {
183            si_link l=(si_link)d;
184            PrintNSpaces(spaces);
185            ::Print("// type : %s\n", slStatus(l, "type"));
186            PrintNSpaces(spaces);
187            ::Print("// mode : %s\n", slStatus(l, "mode"));
188            PrintNSpaces(spaces);
189            ::Print("// name : %s\n", slStatus(l, "name"));
190            PrintNSpaces(spaces);
191            ::Print("// open : %s\n", slStatus(l, "open"));
192            PrintNSpaces(spaces);
193            ::Print("// read : %s\n", slStatus(l, "read"));
194            PrintNSpaces(spaces);
195            ::Print("// write: %s", slStatus(l, "write"));
196          break;
197          }
198        case NUMBER_CMD:
199        case BIGINT_CMD:
200          s=String(d);
201          if (s==NULL) return;
202          PrintNSpaces(spaces);
203          PrintS(s);
204          omFree((ADDRESS)s);
205          break;
206        case LIST_CMD:
207        {
208          lists l=(lists)d;
209          if (l->nr<0)
210          {
211             PrintNSpaces(spaces);
212             PrintS("empty list\n");
213          }
214          else
215          {
216            int i=0;
217            for (;i<=l->nr;i++)
218            {
219              if (l->m[i].rtyp!=DEF_CMD)
220              {
221                PrintNSpaces(spaces);
222                ::Print("[%d]:\n",i+1);
223                l->m[i].Print(NULL,spaces+3);
224              }
225            }
226          }
227          break;
228        }
229#ifdef TEST
230        default:
231          ::Print("Print:unknown type %s(%d)", Tok2Cmdname(t),t);
232#endif
233      } /* end switch: (Typ()) */
234  }
235  if (next!=NULL)
236  {
237    if (t==COMMAND) PrintLn();
238    else if (t!=LIST_CMD) PrintS(" ");
239    next->Print(NULL,spaces);
240  }
241  else if (t!=LIST_CMD)
242  {
243    PrintLn();
244  }
245#ifdef SIQ
246  if (rtyp!=COMMAND)
247#endif
248  {
249    if ((store!=NULL)
250    && (store!=this)
251    && (t/*Typ()*/!=LINK_CMD)
252    && (t/*Typ()*/!=RING_CMD)
253    && (t/*Typ()*/!=QRING_CMD)
254    && (t/*Typ()*/!=POINTER_CMD)
255    && (t/*Typ()*/!=PACKAGE_CMD)
256    && (t/*Typ()*/!=PROC_CMD)
257    && (t/*Typ()*/!=DEF_CMD)
258    )
259    {
260      store->rtyp=t/*Typ()*/;
261      store->data=CopyD();
262      if((e!=NULL)||(attribute!=NULL))
263      {
264        store->attribute=CopyA();
265      }
266      if (e==NULL)
267      {
268        store->flag=flag;
269      }
270      //else
271      //{
272      //}
273    }
274  }
275}
276
277void sleftv::CleanUp(ring r)
278{
279  if ((name!=NULL) && (name!=sNoName) && (rtyp!=IDHDL))
280  {
281    //::Print("free %x (%s)\n",name,name);
282    omFree((ADDRESS)name);
283  }
284  //name=NULL;
285  //flag=0;
286  if (data!=NULL)
287  {
288    switch (rtyp)
289    {
290      case INTVEC_CMD:
291      case INTMAT_CMD:
292        delete (intvec *)data;
293        break;
294      case MAP_CMD:
295        omFree((ADDRESS)((map)data)->preimage);
296        ((map)data)->preimage=NULL;
297        // no break: kill the image as an ideal
298      case MATRIX_CMD:
299      case MODUL_CMD:
300      case IDEAL_CMD:
301        if ((((long)data) & 3)==0)
302        {
303          if(r!=NULL) id_Delete((ideal *)(&data),r);
304        }
305        break;
306      case STRING_CMD:
307        omFree((ADDRESS)data);
308        break;
309      case POLY_CMD:
310      case VECTOR_CMD:
311        if (r!=NULL) p_Delete((poly *)(&data),r);
312        break;
313      case NUMBER_CMD:
314        if (r!=NULL) n_Delete((number *)(&data),r);
315        break;
316      case BIGINT_CMD:
317        nlDelete((number *)(&data),r);
318        break;
319      case LIST_CMD:
320        ((lists)data)->Clean(r); // may contain ring-dep data
321        break;
322      case QRING_CMD:
323      case RING_CMD:
324        rKill((ring)data);
325        break;
326      case PROC_CMD:
327        piKill((procinfov)data);
328        break;
329      case LINK_CMD:
330        slKill((si_link)data);
331        break;
332      case COMMAND:
333      {
334        command cmd=(command)data;
335        if (cmd->arg1.rtyp!=0) cmd->arg1.CleanUp();
336        if (cmd->arg2.rtyp!=0) cmd->arg2.CleanUp();
337        if (cmd->arg3.rtyp!=0) cmd->arg3.CleanUp();
338        omFreeBin((ADDRESS)data, ip_command_bin);
339        break;
340      }
341      case RESOLUTION_CMD:
342        if (r!=NULL) syKillComputation((syStrategy)data,r);
343        break;
344#ifdef TEST
345      // the following types do not take memory
346      // or are not copied
347      case IDHDL:
348      case PACKAGE_CMD:
349      case ANY_TYPE:
350      case VECHO:
351      case VPAGELENGTH:
352      case VPRINTLEVEL:
353      case VCOLMAX:
354      case VTIMER:
355#ifdef HAVE_RTIMER
356      case VRTIMER:
357#endif
358      case VOICE:
359      case VMAXDEG:
360      case VMAXMULT:
361      case TRACE:
362      case VSHORTOUT:
363      case VNOETHER:
364      case VMINPOLY:
365      case LIB_CMD:
366      case 0:
367      case INT_CMD:
368        break;
369      default:
370        ::Print("CleanUp: unknown type %d\n",rtyp);  /* DEBUG */
371#endif
372    } /* end switch: (rtyp) */
373    //data=NULL; // will be done by Init() at the end
374  }
375  if (attribute!=NULL)
376  {
377    switch (rtyp)
378    {
379      case POINTER_CMD:
380      case PACKAGE_CMD:
381      case IDHDL:
382      case ANY_TYPE:
383      case VECHO:
384      case VPAGELENGTH:
385      case VPRINTLEVEL:
386      case VCOLMAX:
387      case VTIMER:
388#ifdef HAVE_RTIMER
389      case VRTIMER:
390#endif
391      case VOICE:
392      case VMAXDEG:
393      case VMAXMULT:
394      case TRACE:
395      case VSHORTOUT:
396      case VNOETHER:
397      case VMINPOLY:
398      case LIB_CMD:
399      case 0:
400        //attribute=NULL; // will be done by Init() at the end
401        break;
402      default:
403      {
404        attr t;
405        while (attribute!=NULL)
406        {
407          t=attribute->next;
408          attribute->kill(currRing);
409          attribute=t;
410        }
411      }
412    }
413  }
414  Subexpr h;
415  while (e!=NULL)
416  {
417    h=e->next;
418    omFreeBin((ADDRESS)e, sSubexpr_bin);
419    e=h;
420  }
421  //rtyp=NONE; // will be done by Init() at the end
422  if (next!=NULL)
423  {
424    leftv tmp_n;
425    do
426    {
427      tmp_n=next->next;
428      //next->name=NULL;
429      next->next=NULL;
430      next->CleanUp(r);
431      omFreeBin((ADDRESS)next, sleftv_bin);
432      next=tmp_n;
433    } while (next!=NULL);
434  }
435  Init();
436}
437
438BOOLEAN sleftv::RingDependend()
439{
440  int rt=Typ();
441  if(::RingDependend(rt) && (rt!=QRING_CMD))
442    return TRUE;
443  if (rt==LIST_CMD)
444    return lRingDependend((lists)Data());
445  return FALSE;
446}
447
448static inline void * s_internalCopy(const int t,  void *d)
449{
450  switch (t)
451  {
452    case INTVEC_CMD:
453    case INTMAT_CMD:
454      return (void *)ivCopy((intvec *)d);
455    case MATRIX_CMD:
456      return (void *)mpCopy((matrix)d);
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 POINTER_CMD:
463      return d;
464    case PACKAGE_CMD:
465      return  (void *)paCopy((package) d);
466    case PROC_CMD:
467      return  (void *)piCopy((procinfov) d);
468    case POLY_CMD:
469    case VECTOR_CMD:
470      return  (void *)pCopy((poly)d);
471    case INT_CMD:
472      return  d;
473    case NUMBER_CMD:
474      return  (void *)nCopy((number)d);
475    case BIGINT_CMD:
476      return  (void *)nlCopy((number)d);
477    case MAP_CMD:
478      return  (void *)maCopy((map)d);
479    case LIST_CMD:
480      return  (void *)lCopy((lists)d);
481    case LINK_CMD:
482      return (void *)slCopy((si_link) d);
483    case RING_CMD:
484    case QRING_CMD:
485      {
486        ring r=(ring)d;
487        r->ref++;
488        return d;
489      }
490    case RESOLUTION_CMD:
491      return (void*)syCopy((syStrategy)d);
492#ifdef TEST
493    case DEF_CMD:
494    case NONE:
495      break; /* error recovery: do nothing */
496    //case COMMAND:
497    default:
498      Warn("s_internalCopy: cannot copy type %s(%d)",
499            Tok2Cmdname(t),t);
500#endif
501  }
502  return NULL;
503}
504
505
506
507void * slInternalCopy(leftv source, const int t, void *d, Subexpr e)
508{
509  if (t==STRING_CMD)
510  {
511      if ((e==NULL)
512      || (source->rtyp==LIST_CMD)
513      || ((source->rtyp==IDHDL)&&(IDTYP((idhdl)source->data)==LIST_CMD)))
514        return (void *)omStrDup((char *)d);
515      else if (e->next==NULL)
516      {
517        char *s=(char*)omAllocBin(size_two_bin);
518        s[0]=*(char *)d;
519        s[1]='\0';
520        return s;
521      }
522      #ifdef TEST
523      else
524      {
525        Werror("not impl. string-op in `%s`",my_yylinebuf);
526        return NULL;
527      }
528      #endif
529  }
530  return s_internalCopy(t,d);
531}
532
533void sleftv::Copy(leftv source)
534{
535  Init();
536  rtyp=source->Typ();
537  void *d=source->Data();
538  if(!errorreported)
539  {
540    data=s_internalCopy(rtyp,d);
541    if ((source->attribute!=NULL)||(source->e!=NULL))
542      attribute=source->CopyA();
543    if(source->e==NULL)
544    {
545      flag=source->flag;
546    }
547    //else
548    //{
549    //}
550    if (source->next!=NULL)
551    {
552      next=(leftv)omAllocBin(sleftv_bin);
553      next->Copy(source->next);
554    }
555  }
556}
557
558void * sleftv::CopyD(int t)
559{
560  if ((rtyp!=IDHDL)&&(e==NULL))
561  {
562    if (iiCheckRing(t)) return NULL;
563    void *x=data;
564    if (rtyp==VNOETHER) x=(void *)pCopy(ppNoether);
565    else if (rtyp==LIB_CMD)
566      x=(void *)omStrDup((char *)Data());
567    else if ((rtyp==VMINPOLY)&& (currRing->minpoly!=NULL)&&(!rField_is_GF()))
568      x=(void *)nCopy(currRing->minpoly);
569    data=NULL;
570    return x;
571  }
572  void *d=Data(); // will also do a iiCheckRing
573  if ((!errorreported) && (d!=NULL)) return slInternalCopy(this,t,d,e);
574  return NULL;
575}
576
577//void * sleftv::CopyD()
578//{
579  //if ((rtyp!=IDHDL)&&(e==NULL)
580  //&&(rtyp!=VNOETHER)&&(rtyp!=LIB_CMD)&&(rtyp!=VMINPOLY))
581  //{
582  //  void *x=data;
583  //  data=NULL;
584  //  return x;
585  //}
586//  return CopyD(Typ());
587//}
588
589attr sleftv::CopyA()
590{
591  attr *a=Attribute();
592  if ((a!=NULL) && (*a!=NULL))
593    return (*a)->Copy();
594  return NULL;
595}
596
597char *  sleftv::String(void *d, BOOLEAN typed, int dim)
598{
599#ifdef SIQ
600  if (rtyp==COMMAND)
601  {
602    ::Print("##command %d\n",((command)data)->op);
603    if (((command)data)->arg1.rtyp!=0)
604      ((command)data)->arg1.Print(NULL,2);
605    if (((command)data)->arg2.rtyp!=0)
606      ((command)data)->arg2.Print(NULL,2);
607    if (((command)data)->arg3.rtyp==0)
608      ((command)data)->arg3.Print(NULL,2);
609    PrintS("##end\n");
610    return omStrDup("");
611  }
612#endif
613  if (d==NULL) d=Data();
614  if (!errorreported)
615  {
616    char *s;
617    const char *n;
618    if (name!=NULL) n=name;
619    else n=sNoName;
620    int t=Typ();
621    switch (t /*Typ()*/)
622    {
623        case INT_CMD:
624          if (typed)
625          {
626            s=(char *)omAlloc(MAX_INT_LEN+7);
627            sprintf(s,"int(%d)",(int)(long)d);
628          }
629          else
630          {
631            s=(char *)omAlloc(MAX_INT_LEN+2);
632            sprintf(s,"%d",(int)(long)d);
633          }
634          return s;
635
636        case STRING_CMD:
637          if (d == NULL)
638          {
639            if (typed) return omStrDup("\"\"");
640            return omStrDup("");
641          }
642          if (typed)
643          {
644            s = (char*) omAlloc(strlen((char*) d) + 3);
645            sprintf(s,"\"%s\"", (char*) d);
646            return s;
647          }
648          else
649          {
650            return omStrDup((char*)d);
651          }
652
653        case POLY_CMD:
654        case VECTOR_CMD:
655          if (typed)
656          {
657            char* ps = pString((poly) d);
658            s = (char*) omAlloc(strlen(ps) + 10);
659            sprintf(s,"%s(%s)", (t /*Typ()*/ == POLY_CMD ? "poly" : "vector"), ps);
660            return s;
661          }
662          else
663            return omStrDup(pString((poly)d));
664
665        case NUMBER_CMD:
666          StringSetS((char*) (typed ? "number(" : ""));
667          if ((rtyp==IDHDL)&&(IDTYP((idhdl)data)==NUMBER_CMD))
668          {
669            nWrite(IDNUMBER((idhdl)data));
670          }
671          else if (rtyp==NUMBER_CMD)
672          {
673            number n=(number)data;
674            nWrite(n);
675            data=(char *)n;
676          }
677          else if((rtyp==VMINPOLY)&&(rField_is_GF()))
678          {
679            nfShowMipo();
680          }
681          else
682          {
683            number n=nCopy((number)d);
684            nWrite(n);
685            nDelete(&n);
686          }
687          s = StringAppendS((char*) (typed ? ")" : ""));
688          return omStrDup(s);
689
690        case BIGINT_CMD:
691          {
692          StringSetS((char*) (typed ? "bigint(" : ""));
693          number nl=(number)d;
694          nlWrite(nl,NULL);
695          s = StringAppendS((char*) (typed ? ")" : ""));
696          return omStrDup(s);
697          }
698
699        case MATRIX_CMD:
700          s= iiStringMatrix((matrix)d,dim);
701          if (typed)
702          {
703            char* ns = (char*) omAlloc(strlen(s) + 40);
704            sprintf(ns, "matrix(ideal(%s),%d,%d)", s,
705                    ((ideal) d)->nrows, ((ideal) d)->ncols);
706            omCheckAddr(ns);
707            return ns;
708          }
709          else
710          {
711            return omStrDup(s);
712          }
713
714        case MODUL_CMD:
715        case IDEAL_CMD:
716        case MAP_CMD:
717          s= iiStringMatrix((matrix)d,dim);
718          if (typed)
719          {
720            char* ns = (char*) omAlloc(strlen(s) + 10);
721            sprintf(ns, "%s(%s)", (t/*Typ()*/==MODUL_CMD ? "module" : "ideal"), s);
722            omCheckAddr(ns);
723            return ns;
724          }
725          return omStrDup(s);
726
727        case INTVEC_CMD:
728        case INTMAT_CMD:
729        {
730          intvec *v=(intvec *)d;
731          s = v->String(dim);
732          if (typed)
733          {
734            char* ns;
735            if (t/*Typ()*/ == INTMAT_CMD)
736            {
737              ns = (char*) omAlloc(strlen(s) + 40);
738              sprintf(ns, "intmat(intvec(%s),%d,%d)", s, v->rows(), v->cols());
739            }
740            else
741            {
742              ns = (char*) omAlloc(strlen(s) + 10);
743              sprintf(ns, "intvec(%s)", s);
744            }
745            omCheckAddr(ns);
746            omFree(s);
747            return ns;
748          }
749          else
750            return s;
751        }
752
753        case RING_CMD:
754        case QRING_CMD:
755          s  = rString((ring)d);
756
757          if (typed)
758          {
759            char* ns;
760            if (t/*Typ()*/ == QRING_CMD)
761            {
762              char* id = iiStringMatrix((matrix) ((ring) d)->qideal, dim);
763              ns = (char*) omAlloc(strlen(s) + strlen(id) + 20);
764              sprintf(ns, "\"%s\";%sideal(%s)", s,(dim == 2 ? "\n" : " "), id);
765            }
766            else
767            {
768              ns = (char*) omAlloc(strlen(s) + 4);
769              sprintf(ns, "\"%s\"", s);
770            }
771            omFree(s);
772            omCheckAddr(ns);
773            return ns;
774          }
775          return s;
776
777        case RESOLUTION_CMD:
778        {
779          lists l = syConvRes((syStrategy)d);
780          s = lString(l, typed, dim);
781          l->Clean();
782          return s;
783        }
784
785        case PROC_CMD:
786        {
787          procinfo* pi = (procinfo*) d;
788          if((pi->language == LANG_SINGULAR) && (pi->data.s.body!=NULL))
789            s = (pi->data.s.body);
790          else
791            s = (char *)"";
792          if (typed)
793          {
794            char* ns = (char*) omAlloc(strlen(s) + 4);
795            sprintf(ns, "\"%s\"", s);
796            omCheckAddr(ns);
797            return ns;
798          }
799          return omStrDup(s);
800        }
801
802        case LINK_CMD:
803          s = slString((si_link) d);
804          if (typed)
805          {
806            char* ns = (char*) omAlloc(strlen(s) + 10);
807            sprintf(ns, "link(\"%s\")", s);
808            omFree(s);
809            omCheckAddr(ns);
810            return ns;
811          }
812          return s;
813
814        case LIST_CMD:
815          return lString((lists) d, typed, dim);
816    } /* end switch: (Typ()) */
817  }
818  return omStrDup("");
819}
820
821
822int  sleftv::Typ()
823{
824  if (e==NULL)
825  {
826    switch (rtyp)
827    {
828      case IDHDL:
829        return IDTYP((idhdl)data);
830      case VECHO:
831      case VPAGELENGTH:
832      case VPRINTLEVEL:
833      case VCOLMAX:
834      case VTIMER:
835#ifdef HAVE_RTIMER
836      case VRTIMER:
837#endif
838      case VOICE:
839      case VMAXDEG:
840      case VMAXMULT:
841      case TRACE:
842      case VSHORTOUT:
843        return INT_CMD;
844      case LIB_CMD:
845        return STRING_CMD;
846      case VMINPOLY:
847        return NUMBER_CMD;
848      case VNOETHER:
849        return POLY_CMD;
850      //case COMMAND:
851      //  return COMMAND;
852      default:
853        return rtyp;
854    }
855  }
856  int r=0;
857  int t=rtyp;
858  if (t==IDHDL) t=IDTYP((idhdl)data);
859  switch (t)
860  {
861    case INTVEC_CMD:
862    case INTMAT_CMD:
863      r=INT_CMD;
864      break;
865    case IDEAL_CMD:
866    case MATRIX_CMD:
867    case MAP_CMD:
868      r=POLY_CMD;
869      break;
870    case MODUL_CMD:
871      r=VECTOR_CMD;
872      break;
873    case STRING_CMD:
874      r=STRING_CMD;
875      break;
876    case LIST_CMD:
877    {
878      lists l;
879      if (rtyp==IDHDL) l=IDLIST((idhdl)data);
880      else             l=(lists)data;
881      if ((0<e->start)&&(e->start<=l->nr+1))
882      {
883        Subexpr tmp=l->m[e->start-1].e;
884        l->m[e->start-1].e=e->next;
885        r=l->m[e->start-1].Typ();
886        e->next=l->m[e->start-1].e;
887        l->m[e->start-1].e=tmp;
888      }
889      else
890      {
891        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
892        r=NONE;
893      }
894      break;
895    }
896    default:
897      Werror("cannot index type %d",t);
898  }
899  return r;
900}
901
902int  sleftv::LTyp()
903{
904  lists l=NULL;
905  int r;
906  if (rtyp==LIST_CMD)
907    l=(lists)data;
908  else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
909    l=IDLIST((idhdl)data);
910  else
911    return Typ();
912  //if (l!=NULL)
913  {
914    if ((e!=NULL) && (e->next!=NULL))
915    {
916      if ((0<e->start)&&(e->start<=l->nr+1))
917      {
918        l->m[e->start-1].e=e->next;
919        r=l->m[e->start-1].LTyp();
920        l->m[e->start-1].e=NULL;
921      }
922      else
923      {
924        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
925        r=NONE;
926      }
927      return r;
928    }
929    return LIST_CMD;
930  }
931  return Typ();
932}
933
934void sleftv::SetData(void* what)
935{
936  if (rtyp == IDHDL)
937  {
938    IDDATA((idhdl)data) = (char *)what;
939  }
940  else
941  {
942    data = what;
943  }
944}
945
946void * sleftv::Data()
947{
948  if ((rtyp!=IDHDL) && iiCheckRing(rtyp))
949     return NULL;
950  if (e==NULL)
951  {
952    switch (rtyp)
953    {
954      case VECHO:      return (void *)si_echo;
955      case VPAGELENGTH:return (void *)pagelength;
956      case VPRINTLEVEL:return (void *)printlevel;
957      case VCOLMAX:    return (void *)colmax;
958      case VTIMER:     return (void *)getTimer();
959#ifdef HAVE_RTIMER
960      case VRTIMER:    return (void *)getRTimer();
961#endif
962      case VOICE:      return (void *)(myynest+1);
963      case VMAXDEG:    return (void *)Kstd1_deg;
964      case VMAXMULT:   return (void *)Kstd1_mu;
965      case TRACE:      return (void *)traceit;
966      case VSHORTOUT:  return (void *)(currRing != NULL ? currRing->ShortOut : 0);
967      case VMINPOLY:   if (currRing != NULL &&
968                           (currRing->minpoly!=NULL)&&(!rField_is_GF()))
969                       /* Q(a), Fp(a), but not GF(q) */
970                         return (void *)currRing->minpoly;
971                       else
972                         return (void *)nNULL;
973      case VNOETHER:   return (void *) ppNoether;
974      case LIB_CMD:    {
975                         return (void *)sNoName;
976                       }
977      case IDHDL:
978        return IDDATA((idhdl)data);
979      case POINTER_CMD:
980        return IDDATA((idhdl)data);
981      case COMMAND:
982        //return NULL;
983      default:
984        return data;
985    }
986  }
987  /* e != NULL : */
988  int t=rtyp;
989  void *d=data;
990  if (t==IDHDL)
991  {
992    t=((idhdl)data)->typ;
993    d=IDDATA((idhdl)data);
994  }
995  if (iiCheckRing(t))
996    return NULL;
997  char *r=NULL;
998  int index=e->start;
999  switch (t)
1000  {
1001    case INTVEC_CMD:
1002    {
1003      intvec *iv=(intvec *)d;
1004      if ((index<1)||(index>iv->length()))
1005      {
1006        if (!errorreported)
1007          Werror("wrong range[%d] in intvec(%d)",index,iv->length());
1008      }
1009      else
1010        r=(char *)((*iv)[index-1]);
1011      break;
1012    }
1013    case INTMAT_CMD:
1014    {
1015      intvec *iv=(intvec *)d;
1016      if ((index<1)
1017         ||(index>iv->rows())
1018         ||(e->next->start<1)
1019         ||(e->next->start>iv->cols()))
1020      {
1021        if (!errorreported)
1022        Werror("wrong range[%d,%d] in intmat(%dx%d)",index,e->next->start,
1023                                                     iv->rows(),iv->cols());
1024      }
1025      else
1026        r=(char *)(IMATELEM((*iv),index,e->next->start));
1027      break;
1028    }
1029    case IDEAL_CMD:
1030    case MODUL_CMD:
1031    case MAP_CMD:
1032    {
1033      ideal I=(ideal)d;
1034      if ((index<1)||(index>IDELEMS(I)))
1035      {
1036        if (!errorreported)
1037          Werror("wrong range[%d] in ideal/module(%d)",index,IDELEMS(I));
1038      }
1039      else
1040        r=(char *)I->m[index-1];
1041      break;
1042    }
1043    case STRING_CMD:
1044    {
1045      // this was a memory leak
1046      // we evalute it, cleanup and replace this leftv by it's evalutated form
1047      // the evalutated form will be build in tmp
1048      sleftv tmp;
1049      tmp.Init();
1050      tmp.rtyp=STRING_CMD;
1051      r=(char *)omAllocBin(size_two_bin);
1052      if ((index>0)&& (index<=(int)strlen((char *)d)))
1053      {
1054        r[0]=*(((char *)d)+index-1);
1055        r[1]='\0';
1056      }
1057      else
1058      {
1059        r[0]='\0';
1060      }
1061      tmp.data=r;
1062      if ((rtyp==IDHDL)||(rtyp==STRING_CMD))
1063      {
1064        tmp.next=next; next=NULL;
1065        //if (rtyp==STRING_CMD) { omFree((ADDRESS)data); }
1066        //data=NULL;
1067        d=NULL;
1068        CleanUp();
1069        memcpy(this,&tmp,sizeof(tmp));
1070      }
1071      // and, remember, r is also the result...
1072      else
1073      {
1074        // ???
1075        // here we still have a memory leak...
1076        // example: list L="123","456";
1077        // L[1][2];
1078        // therefore, it should never happen:
1079        assume(0);
1080        // but if it happens: here is the temporary fix:
1081        // omMarkAsStaticAddr(r);
1082      }
1083      break;
1084    }
1085    case MATRIX_CMD:
1086    {
1087      if ((index<1)
1088         ||(index>MATROWS((matrix)d))
1089         ||(e->next->start<1)
1090         ||(e->next->start>MATCOLS((matrix)d)))
1091      {
1092        if (!errorreported)
1093          Werror("wrong range[%d,%d] in intmat(%dx%d)",
1094                  index,e->next->start,
1095                  MATROWS((matrix)d),MATCOLS((matrix)d));
1096      }
1097      else
1098        r=(char *)MATELEM((matrix)d,index,e->next->start);
1099      break;
1100    }
1101    case LIST_CMD:
1102    {
1103      lists l=(lists)d;
1104      if ((0<index)&&(index<=l->nr+1))
1105      {
1106        if ((e->next!=NULL)
1107        && (l->m[index-1].rtyp==STRING_CMD))
1108        // string[..].Data() modifies sleftv, so let's do it ourself
1109        {
1110          char *dd=(char *)l->m[index-1].data;
1111          int j=e->next->start-1;
1112          r=(char *)omAllocBin(size_two_bin);
1113          if ((j>=0) && (j<(int)strlen(dd)))
1114          {
1115            r[0]=*(dd+j);
1116            r[1]='\0';
1117          }
1118          else
1119          {
1120            r[0]='\0';
1121          }
1122        }
1123        else
1124        {
1125          Subexpr tmp=l->m[index-1].e;
1126          l->m[index-1].e=e->next;
1127          r=(char *)l->m[index-1].Data();
1128          e->next=l->m[index-1].e;
1129          l->m[index-1].e=tmp;
1130        }
1131      }
1132      else //if (!errorreported)
1133        Werror("wrong range[%d] in list(%d)",index,l->nr+1);
1134      break;
1135    }
1136#ifdef TEST
1137    default:
1138      Werror("cannot index type %s(%d)",Tok2Cmdname(t),t);
1139#endif
1140  }
1141  return r;
1142}
1143
1144attr * sleftv::Attribute()
1145{
1146  if (e==NULL) return &attribute;
1147  if ((rtyp==LIST_CMD)
1148  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD)))
1149  {
1150    leftv v=LData();
1151    return &(v->attribute);
1152  }
1153  return NULL;
1154}
1155
1156leftv sleftv::LData()
1157{
1158  if (e!=NULL)
1159  {
1160    lists l=NULL;
1161
1162    if (rtyp==LIST_CMD)
1163      l=(lists)data;
1164    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1165      l=IDLIST((idhdl)data);
1166    if (l!=NULL)
1167    {
1168      if ((0>=e->start)||(e->start>l->nr+1))
1169        return NULL;
1170      if (e->next!=NULL)
1171      {
1172        l->m[e->start-1].e=e->next;
1173        leftv r=l->m[e->start-1].LData();
1174        l->m[e->start-1].e=NULL;
1175        return r;
1176      }
1177      return &(l->m[e->start-1]);
1178    }
1179  }
1180  return this;
1181}
1182
1183leftv sleftv::LHdl()
1184{
1185  if (e!=NULL)
1186  {
1187    lists l=NULL;
1188
1189    if (rtyp==LIST_CMD)
1190      l=(lists)data;
1191    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1192      l=IDLIST((idhdl)data);
1193    if (l!=NULL)
1194    {
1195      if ((0>=e->start)||(e->start>l->nr+1))
1196        return NULL;
1197      if (e->next!=NULL)
1198      {
1199        l->m[e->start-1].e=e->next;
1200        leftv r=l->m[e->start-1].LHdl();
1201        l->m[e->start-1].e=NULL;
1202        return r;
1203      }
1204      return &(l->m[e->start-1]);
1205    }
1206  }
1207  return this;
1208}
1209
1210BOOLEAN assumeStdFlag(leftv h)
1211{
1212  if ((h->e!=NULL)&&(h->LTyp()==LIST_CMD))
1213  {
1214    return assumeStdFlag(h->LData());
1215  }
1216  if (!hasFlag(h,FLAG_STD))
1217  {
1218    if (!TEST_VERB_NSB)
1219      Warn("%s is no standard basis",h->Name());
1220    return FALSE;
1221  }
1222  return TRUE;
1223}
1224
1225/*2
1226* transforms a name (as an string created by omAlloc or omStrDup)
1227* into an expression (sleftv), deletes the string
1228* utility for grammar and iparith
1229*/
1230void syMake(leftv v,const char * id, idhdl packhdl)
1231{
1232  /* resolv an identifier: (to DEF_CMD, if siq>0)
1233  * 1) reserved id: done by scanner
1234  * 2) `basering` / 'Current`
1235  * 3) existing identifier, local
1236  * 4) ringvar, local ring
1237  * 5) existing identifier, global
1238  * 6) monom (resp. number), local ring: consisting of:
1239  * 6') ringvar, global ring
1240  * 6'') monom (resp. number), local ring
1241  * 7) monom (resp. number), non-local ring
1242  * 8) basering
1243  * 9) `_`
1244  * 10) everything else is of type 0
1245  */
1246#ifdef TEST
1247  if ((*id<' ')||(*id>(char)126))
1248  {
1249    Print("wrong id :%s:\n",id);
1250  }
1251#endif
1252  v->Init();
1253  v->packhdl = NULL;
1254  if(packhdl != NULL)
1255  {
1256  //  Print("setting req_packhdl to %s\n",IDID(packhdl));
1257    v->req_packhdl = IDPACKAGE(packhdl);
1258  }
1259  else v->req_packhdl = currPack;
1260//  if (v->req_packhdl!=basePack)
1261//    Print("search %s in %s\n",id,v->req_packhdl->libname);
1262  idhdl h=NULL;
1263#ifdef SIQ
1264  if (siq<=0)
1265#endif
1266  {
1267    if (!isdigit(id[0]))
1268    {
1269      if (strcmp(id,"basering")==0)
1270      {
1271        if (currRingHdl!=NULL)
1272        {
1273          if (id!=IDID(currRingHdl)) omFree((ADDRESS)id);
1274          h=currRingHdl;
1275          goto id_found;
1276        }
1277        else
1278        {
1279          v->name = id;
1280          return; /* undefined */
1281        }
1282      }
1283      else if (strcmp(id,"Current")==0)
1284      {
1285        if (currPackHdl!=NULL)
1286        {
1287          omFree((ADDRESS)id);
1288          h=currPackHdl;
1289          goto id_found;
1290        }
1291        else
1292        {
1293          v->name = id;
1294          return; /* undefined */
1295        }
1296      }
1297      if(v->req_packhdl!=currPack)
1298      {
1299        h=v->req_packhdl->idroot->get(id,myynest);
1300      }
1301      else
1302      h=ggetid(id);
1303      /* 3) existing identifier, local */
1304      if ((h!=NULL) && (IDLEV(h)==myynest))
1305      {
1306        if (id!=IDID(h)) omFree((ADDRESS)id);
1307        goto id_found;
1308      }
1309    }
1310    /* 4. local ring: ringvar */
1311    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1312    {
1313      int vnr;
1314      if ((vnr=rIsRingVar(id))>=0)
1315      {
1316        poly p=pOne();
1317        pSetExp(p,vnr+1,1);
1318        pSetm(p);
1319        v->data = (void *)p;
1320        v->name = id;
1321        v->rtyp = POLY_CMD;
1322        return;
1323      }
1324    }
1325    /* 5. existing identifier, global */
1326    if (h!=NULL)
1327    {
1328      if (id!=IDID(h)) omFree((ADDRESS)id);
1329      goto id_found;
1330    }
1331    /* 6. local ring: number/poly */
1332    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1333    {
1334      BOOLEAN ok=FALSE;
1335      poly p = (!yyInRingConstruction) ? pmInit(id,ok) : (poly)NULL;
1336      if (ok)
1337      {
1338        if (p==NULL)
1339        {
1340          v->data = (void *)nInit(0);
1341          v->rtyp = NUMBER_CMD;
1342          #ifdef HAVE_PLURAL
1343          // in this case we may have monomials equal to 0 in p_Read
1344          v->name = id;
1345          #else
1346          omFree((ADDRESS)id);
1347          #endif
1348        }
1349        else
1350        if (pIsConstant(p))
1351        {
1352          v->data = pGetCoeff(p);
1353          pGetCoeff(p)=NULL;
1354          pLmFree(p);
1355          v->rtyp = NUMBER_CMD;
1356          v->name = id;
1357        }
1358        else
1359        {
1360          v->data = p;
1361          v->rtyp = POLY_CMD;
1362          v->name = id;
1363        }
1364        return;
1365      }
1366    }
1367    /* 7. non-local ring: number/poly */
1368    {
1369      BOOLEAN ok=FALSE;
1370      poly p = ((currRing!=NULL)     /* ring required */
1371               && (currRingHdl!=NULL)
1372               && (!yyInRingConstruction) /* not in decl */
1373               && (IDLEV(currRingHdl)!=myynest)) /* already in case 4/6 */
1374                     ? pmInit(id,ok) : (poly)NULL;
1375      if (ok)
1376      {
1377        if (p==NULL)
1378        {
1379          v->data = (void *)nInit(0);
1380          v->rtyp = NUMBER_CMD;
1381          #ifdef HAVE_PLURAL
1382          // in this case we may have monomials equal to 0 in p_Read
1383          v->name = id;
1384          #else
1385          omFree((ADDRESS)id);
1386          #endif
1387        }
1388        else
1389        if (pIsConstant(p))
1390        {
1391          v->data = pGetCoeff(p);
1392          pGetCoeff(p)=NULL;
1393          pLmFree(p);
1394          v->rtyp = NUMBER_CMD;
1395          v->name = id;
1396        }
1397        else
1398        {
1399          v->data = p;
1400          v->rtyp = POLY_CMD;
1401          v->name = id;
1402        }
1403        return;
1404      }
1405    }
1406    /* 8. basering ? */
1407    if ((myynest>1)&&(currRingHdl!=NULL))
1408    {
1409      if (strcmp(id,IDID(currRingHdl))==0)
1410      {
1411        if (IDID(currRingHdl)!=id) omFree((ADDRESS)id);
1412        h=currRingHdl;
1413        goto id_found;
1414      }
1415    }
1416    if((v->req_packhdl!=basePack) && (v->req_packhdl==currPack))
1417    {
1418      h=basePack->idroot->get(id,myynest);
1419      if (h!=NULL)
1420      {
1421        if (id!=IDID(h)) omFree((ADDRESS)id);
1422        v->req_packhdl=basePack;
1423        goto id_found;
1424      }
1425    }
1426  }
1427#ifdef SIQ
1428  else
1429    v->rtyp=DEF_CMD;
1430#endif
1431  /* 9: _ */
1432  if (strcmp(id,"_")==0)
1433  {
1434    omFree((ADDRESS)id);
1435    v->Copy(&sLastPrinted);
1436  }
1437  else
1438  {
1439    /* 10: everything else */
1440    /* v->rtyp = UNKNOWN;*/
1441    v->name = id;
1442  }
1443  return;
1444id_found: // we have an id (in h) found, to set the data in from h
1445  v->rtyp = IDHDL;
1446  v->data = (char *)h;
1447  v->flag = IDFLAG(h);
1448  v->name = IDID(h);
1449  v->attribute=IDATTR(h);
1450}
1451
1452int sleftv::Eval()
1453{
1454  BOOLEAN nok=FALSE;
1455  leftv nn=next;
1456  next=NULL;
1457  if(rtyp==IDHDL)
1458  {
1459    int t=Typ();
1460    if (t!=PROC_CMD)
1461    {
1462      void *d=CopyD(t);
1463      data=d;
1464      rtyp=t;
1465      name=NULL;
1466      e=NULL;
1467    }
1468  }
1469  else if (rtyp==COMMAND)
1470  {
1471    command d=(command)data;
1472    if(d->op==PROC_CMD) //assume d->argc==2
1473    {
1474      char *what=(char *)(d->arg1.Data());
1475      idhdl h=ggetid(what);
1476      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1477      {
1478        nok=d->arg2.Eval();
1479        if(!nok)
1480        {
1481          leftv r=iiMake_proc(h,req_packhdl,&d->arg2);
1482          if (r!=NULL)
1483            memcpy(this,r,sizeof(sleftv));
1484          else
1485            nok=TRUE;
1486        }
1487      }
1488      else nok=TRUE;
1489    }
1490    else if (d->op=='=') //assume d->argc==2
1491    {
1492      if ((d->arg1.rtyp!=IDHDL)&&(d->arg1.rtyp!=DEF_CMD))
1493      {
1494        nok=d->arg1.Eval();
1495      }
1496      if (!nok)
1497      {
1498        const char *n=d->arg1.name;
1499        nok=(n == NULL) || d->arg2.Eval();
1500        if (!nok)
1501        {
1502          int save_typ=d->arg1.rtyp;
1503          omCheckAddr((ADDRESS)n);
1504          if (d->arg1.rtyp!=IDHDL)
1505          syMake(&d->arg1,n);
1506          omCheckAddr((ADDRESS)d->arg1.name);
1507          if (d->arg1.rtyp==IDHDL)
1508          {
1509            n=omStrDup(IDID((idhdl)d->arg1.data));
1510            killhdl((idhdl)d->arg1.data);
1511            d->arg1.Init();
1512            //d->arg1.data=NULL;
1513            d->arg1.name=n;
1514          }
1515          d->arg1.rtyp=DEF_CMD;
1516          sleftv t;
1517          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1518          if (::RingDependend(d->arg2.rtyp))
1519            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1520          else
1521            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&IDROOT);
1522          memcpy(&d->arg1,&t,sizeof(sleftv));
1523          omCheckAddr((ADDRESS)d->arg1.name);
1524          nok=nok||iiAssign(&d->arg1,&d->arg2);
1525          omCheckIf(d->arg1.name != NULL,  // OB: ????
1526                    omCheckAddr((ADDRESS)d->arg1.name));
1527          if (!nok)
1528          {
1529            memset(&d->arg1,0,sizeof(sleftv));
1530            this->CleanUp();
1531            rtyp=NONE;
1532          }
1533        }
1534      }
1535      else nok=TRUE;
1536    }
1537    else if (d->argc==1)
1538    {
1539      nok=d->arg1.Eval();
1540      nok=nok||iiExprArith1(this,&d->arg1,d->op);
1541    }
1542    else if(d->argc==2)
1543    {
1544      nok=d->arg1.Eval();
1545      nok=nok||d->arg2.Eval();
1546      nok=nok||iiExprArith2(this,&d->arg1,d->op,&d->arg2);
1547    }
1548    else if(d->argc==3)
1549    {
1550      nok=d->arg1.Eval();
1551      nok=nok||d->arg2.Eval();
1552      nok=nok||d->arg3.Eval();
1553      nok=nok||iiExprArith3(this,d->op,&d->arg1,&d->arg2,&d->arg3);
1554    }
1555    else if(d->argc!=0)
1556    {
1557      nok=d->arg1.Eval();
1558      nok=nok||iiExprArithM(this,&d->arg1,d->op);
1559    }
1560    else // d->argc == 0
1561    {
1562      nok = iiExprArithM(this, NULL, d->op);
1563    }
1564  }
1565  else if (((rtyp==0)||(rtyp==DEF_CMD))
1566    &&(name!=NULL))
1567  {
1568     syMake(this,name);
1569  }
1570#ifdef MDEBUG
1571  switch(Typ())
1572  {
1573    case NUMBER_CMD:
1574#ifdef LDEBUG
1575      nTest((number)Data());
1576#endif
1577      break;
1578    case BIGINT_CMD:
1579#ifdef LDEBUG
1580      nlTest((number)Data());
1581#endif
1582      break;
1583    case POLY_CMD:
1584      pTest((poly)Data());
1585      break;
1586    case IDEAL_CMD:
1587    case MODUL_CMD:
1588    case MATRIX_CMD:
1589      {
1590        ideal id=(ideal)Data();
1591        omCheckAddrSize(id,sizeof(*id));
1592        int i=id->ncols*id->nrows-1;
1593        for(;i>=0;i--) pTest(id->m[i]);
1594      }
1595      break;
1596  }
1597#endif
1598  if (nn!=NULL) nok=nok||nn->Eval();
1599  next=nn;
1600  return nok;
1601}
1602
1603const char *iiSleftv2name(leftv v)
1604{
1605  return(v->name);
1606}
1607
1608void * sattr::CopyA()
1609{
1610  omCheckAddrSize(this,sizeof(sattr));
1611  return s_internalCopy(atyp,data);
1612}
1613
Note: See TracBrowser for help on using the repository browser.