source: git/Singular/subexpr.cc @ a1a595

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