source: git/Singular/subexpr.cc @ 56c52a7

spielwiese
Last change on this file since 56c52a7 was 9c9fb9, checked in by Olaf Bachmann <obachman@…>, 26 years ago
* reverted to previous version, for mpsr_s.tst yielded core dump git-svn-id: file:///usr/local/Singular/svn/trunk@2486 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 29.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: handling of leftv
6*/
7
8#include <stdlib.h>
9#include <stdio.h>
10#include <string.h>
11#include <ctype.h>
12#include <unistd.h>
13
14#include "mod2.h"
15#include "tok.h"
16#include "ipid.h"
17#include "intvec.h"
18#include "mmemory.h"
19#include "febase.h"
20#include "polys.h"
21#include "ideals.h"
22#include "maps.h"
23#include "matpol.h"
24#include "kstd1.h"
25#include "timer.h"
26#include "ring.h"
27#include "ffields.h"
28#include "numbers.h"
29#include "ipshell.h"
30#include "lists.h"
31#include "attrib.h"
32#include "silink.h"
33#include "syz.h"
34#include "subexpr.h"
35
36sleftv     sLastPrinted;
37const char sNoName[]="_";
38#ifdef SIQ
39BOOLEAN siq=FALSE;
40#endif
41
42void sleftv::Set(int val)
43{
44  Init();
45  rtyp = INT_CMD;
46  data = (void *)val;
47}
48
49int sleftv::listLength()
50{
51  int n = 1;
52  leftv sl = next;
53  while (sl!=NULL)
54  {
55    n++;
56    sl=sl->next;
57  }
58  return n;
59}
60
61void sleftv::Print(leftv store, int spaces)
62{
63  int  t=Typ();
64  if (errorreported) return;
65#ifdef SIQ
66  if (rtyp==COMMAND)
67  {
68    command c=(command)data;
69    char ch[2];
70    ch[0]=c->op;ch[1]='\0';
71    char *s=ch;
72    if (c->op>127) s=Tok2Cmdname(c->op);
73    ::Print("##command %d(%s), %d args\n",
74      c->op, s, c->argc);
75    if (c->argc>0)
76      c->arg1.Print(NULL,spaces+2);
77    if(c->argc<4)
78    {
79      if (c->argc>1)
80        c->arg2.Print(NULL,spaces+2);
81      if (c->argc>2)
82        c->arg3.Print(NULL,spaces+2);
83    }
84    PrintS("##end");
85  }
86  else
87#endif
88  {
89    const char *n=Name();
90    char *s;
91    void *d=Data();
92    if (errorreported)
93      return;
94    if ((store!=NULL)&&(store!=this))
95      store->CleanUp();
96   
97    switch (t /*=Typ()*/)
98      {
99        case UNKNOWN:
100        case DEF_CMD:
101        case PACKAGE_CMD:
102          ::Print("%-*.*s`%s`",spaces,spaces," ",n);
103          break;
104        case NONE:
105          return;
106        case INTVEC_CMD:
107        case INTMAT_CMD:
108          ((intvec *)d)->show(t,spaces);
109          break;
110        case RING_CMD:
111        case QRING_CMD:
112          ::Print("%-*.*s",spaces,spaces," ");
113          rWrite((ring)d);
114          break;
115        case MATRIX_CMD:
116          iiWriteMatrix((matrix)d,n,2,spaces);
117          break;
118        case MAP_CMD:
119        case MODUL_CMD:
120        case IDEAL_CMD:
121          iiWriteMatrix((matrix)d,n,1,spaces);
122          break;
123        case POLY_CMD:
124        case VECTOR_CMD:
125          ::Print("%-*.*s",spaces,spaces," ");
126          pWrite0((poly)d);
127          break;
128        case RESOLUTION_CMD:
129          syPrint((syStrategy)d);
130          break; 
131        case STRING_CMD:
132          ::Print("%-*.*s%s",spaces,spaces," ",(char *)d);
133          break;
134       case INT_CMD:
135          ::Print("%-*.*s%d",spaces,spaces," ",(int)d);
136          break;
137       case PROC_CMD:
138         {
139           procinfov pi=(procinfov)d;
140           ::Print("%-*.*s// libname  : %s\n",spaces,spaces," ",
141                   piProcinfo(pi, "libname"));
142           ::Print("%-*.*s// procname : %s\n",spaces,spaces," ",
143                   piProcinfo(pi, "procname"));
144           ::Print("%-*.*s// type     : %s",spaces,spaces," ",
145                   piProcinfo(pi, "type"));
146           //      ::Print("%-*.*s// ref      : %s",spaces,spaces," ",
147           //   piProcinfo(pi, "ref"));
148           break;
149         }
150       case POINTER_CMD:
151         { package pack = (package)d;
152         ::Print("%-*.*s// %s\n",spaces,spaces," ","PointerTest");
153         ::Print("%-*.*s// %s",spaces,spaces," ",IDID(pack->idroot));
154         //::Print(((char *)(pack->idroot)->data), spaces);
155         break;
156         }
157       case LINK_CMD:
158          {
159            si_link l=(si_link)d;
160            ::Print("%-*.*s// type : %s\n",spaces,spaces," ",
161                    slStatus(l, "type"));
162            ::Print("%-*.*s// mode : %s\n",spaces,spaces," ",
163                    slStatus(l, "mode"));
164            ::Print("%-*.*s// name : %s\n",spaces,spaces," ",
165                    slStatus(l, "name"));
166            ::Print("%-*.*s// open : %s\n",spaces,spaces," ",
167                    slStatus(l, "open"));
168            ::Print("%-*.*s// read : %s\n",spaces,spaces," ",
169                    slStatus(l, "read"));
170            ::Print("%-*.*s// write: %s",spaces,spaces," ",
171                    slStatus(l, "write"));
172          break;
173          }
174        case NUMBER_CMD:
175          s=String(d);
176          if (s==NULL) return;
177          ::Print("%-*.*s",spaces,spaces," ");
178          PrintS(s);
179          FreeL((ADDRESS)s);
180          break;
181        case LIST_CMD:
182        {
183          lists l=(lists)d;
184          if (l->nr<0)
185             ::Print("%-*.*sempty list\n",spaces,spaces," ");
186          else
187          {
188            int i=0;
189            for (;i<=l->nr;i++)
190            {
191              if (l->m[i].rtyp!=DEF_CMD)
192              {
193                ::Print("%-*.*s[%d]:\n",spaces,spaces," ",i+1);
194                l->m[i].Print(NULL,spaces+3);
195              }
196            }
197          }
198          break;
199        }
200#ifdef TEST
201        default:
202          ::Print("Print:unknown type %s(%d)", Tok2Cmdname(t),t);
203#endif
204      } /* end switch: (Typ()) */
205  }
206  if (next!=NULL)
207  {
208    if (t==COMMAND) PrintLn();
209    else if (t!=LIST_CMD) PrintS(" ");
210    next->Print(NULL,spaces);
211  }
212  else if (t!=LIST_CMD)
213  {
214    PrintLn();
215  } 
216#ifdef SIQ
217  if (rtyp!=COMMAND)
218#endif
219  {
220    if ((store!=NULL)
221    && (store!=this)
222    && (t/*Typ()*/!=LINK_CMD)
223    && (t/*Typ()*/!=RING_CMD)
224    && (t/*Typ()*/!=QRING_CMD)
225    && (t/*Typ()*/!=POINTER_CMD)
226    && (t/*Typ()*/!=PACKAGE_CMD)
227    && (t/*Typ()*/!=PROC_CMD)
228    && (t/*Typ()*/!=DEF_CMD)
229    )
230    {
231      store->rtyp=t/*Typ()*/;
232      store->data=CopyD();
233    }
234  }
235}
236
237void sleftv::CleanUp()
238{
239  if ((name!=NULL) && (name!=sNoName) && (rtyp!=IDHDL))
240  {
241    //::Print("free %x (%s)\n",name,name);
242    FreeL((ADDRESS)name);
243  }
244  name=NULL;
245  if (data!=NULL)
246  {
247    switch (rtyp)
248    {
249      case INTVEC_CMD:
250      case INTMAT_CMD:
251        delete (intvec *)data;
252        break;
253      case MAP_CMD:
254        FreeL((ADDRESS)((map)data)->preimage);
255        ((map)data)->preimage=NULL;
256        // no break: kill the image as an ideal
257      case MATRIX_CMD:
258      case MODUL_CMD:
259      case IDEAL_CMD:
260        idDelete((ideal *)(&data));
261        break;
262      case STRING_CMD:
263        FreeL((ADDRESS)data);
264        break;
265      case POLY_CMD:
266      case VECTOR_CMD:
267        pDelete((poly *)(&data));
268        break;
269      case NUMBER_CMD:
270        nDelete((number *)(&data));
271        break;
272      case LIST_CMD:
273        ((lists)data)->Clean();
274        break;
275      case QRING_CMD:
276      case RING_CMD:
277        rKill((ring)data);
278        break;
279      case PROC_CMD:
280        piKill((procinfov)data);
281        break;
282      case LINK_CMD:
283        slKill((si_link)data);
284        break;
285      case COMMAND:
286      {
287        command cmd=(command)data;
288        if (cmd->arg1.rtyp!=0) cmd->arg1.CleanUp();
289        if (cmd->arg2.rtyp!=0) cmd->arg2.CleanUp();
290        if (cmd->arg3.rtyp!=0) cmd->arg3.CleanUp();
291        Free((ADDRESS)data,sizeof(ip_command));
292        break;
293      }
294      case RESOLUTION_CMD:
295      {
296        syKillComputation((syStrategy)data);
297        break;
298      }
299#ifdef TEST
300      // the following types do not take memory
301      // or are not copied
302      case IDHDL:
303      case PACKAGE_CMD:
304      case ANY_TYPE:
305#ifdef SRING
306      case VALTVARS:
307#endif
308      case VECHO:
309      case VPAGELENGTH:
310      case VPRINTLEVEL:
311      case VCOLMAX:
312      case VTIMER:
313#ifdef HAVE_RTIMER
314        case VRTIMER:
315#endif         
316      case VOICE:
317      case VMAXDEG:
318      case VMAXMULT:
319      case TRACE:
320      case VSHORTOUT:
321      case VNOETHER:
322      case VMINPOLY:
323      case LIB_CMD:
324      case 0:
325      case INT_CMD:
326        break;
327      default:
328        ::Print("CleanUp: unknown type %d\n",rtyp);  /* DEBUG */
329#endif         
330    } /* end switch: (rtyp) */
331    data=NULL;
332  }
333  if (attribute!=NULL)
334  {
335    switch (rtyp)
336    {
337      case POINTER_CMD:
338      case PACKAGE_CMD:
339      case IDHDL:
340      case ANY_TYPE:
341#ifdef SRING
342      case VALTVARS:
343#endif
344      case VECHO:
345      case VPAGELENGTH:
346      case VPRINTLEVEL:
347      case VCOLMAX:
348      case VTIMER:
349#ifdef HAVE_RTIMER
350      case VRTIMER:
351#endif         
352      case VOICE:
353      case VMAXDEG:
354      case VMAXMULT:
355      case TRACE:
356      case VSHORTOUT:
357      case VNOETHER:
358      case VMINPOLY:
359      case LIB_CMD:
360      case 0:
361        attribute=NULL;
362        break;
363      default:
364      {
365        attr t;
366        while (attribute!=NULL)
367        {
368          t=attribute->next;
369          attribute->kill();
370          attribute=t;
371        }
372      }
373    }
374  }
375  Subexpr h;
376  while (e!=NULL)
377  {
378    h=e->next;
379    Free((ADDRESS)e,sizeof(*e));
380    e=h;
381  }
382  rtyp=NONE;
383  if (next!=NULL)
384  {
385    next->name=NULL;
386    next->CleanUp();
387    Free((ADDRESS)next,sizeof(sleftv));
388    next=NULL;
389  }
390}
391
392void * slInternalCopy(leftv source, int t, void *d, Subexpr e)
393{
394  switch (t)
395  {
396    case INTVEC_CMD:
397    case INTMAT_CMD:
398      return (void *)ivCopy((intvec *)d);
399    case MATRIX_CMD:
400      return (void *)mpCopy((matrix)d);
401    case IDEAL_CMD:
402    case MODUL_CMD:
403      return  (void *)idCopy((ideal)d);
404    case STRING_CMD:
405      if ((e==NULL)
406      || (source->rtyp==LIST_CMD)
407      || ((source->rtyp==IDHDL)&&(IDTYP((idhdl)source->data)==LIST_CMD)))
408        return (void *)mstrdup((char *)d);
409      else if (e->next==NULL)
410      {
411        char *s=(char *)AllocL(2);
412        s[0]=*(char *)d;
413        s[1]='\0';
414        return s;
415      }
416      #ifdef TEST
417      else
418      {
419        Werror("not impl. string-op in `%s`",my_yylinebuf);
420        return NULL;
421      }
422      #endif
423    case POINTER_CMD:
424      return d;
425    case PROC_CMD:
426      return  (void *)piCopy((procinfov) d);
427    case POLY_CMD:
428    case VECTOR_CMD:
429      return  (void *)pCopy((poly)d);
430    case INT_CMD:
431      return  d;
432    case NUMBER_CMD:
433      return  (void *)nCopy((number)d);
434    case MAP_CMD:
435      return  (void *)maCopy((map)d);
436    case LIST_CMD:
437      return  (void *)lCopy((lists)d);
438    case LINK_CMD:
439      return (void *)slCopy((si_link) d);
440    case RING_CMD:
441    case QRING_CMD:
442      {
443        ring r=(ring)d;
444        r->ref++;
445        return d;
446      }
447    case RESOLUTION_CMD:
448      return (void*)syCopy((syStrategy)d);
449#ifdef TEST
450    case DEF_CMD:
451    case NONE:
452      break; /* error recovery: do nothing */
453    //case COMMAND:
454    default:
455      Warn("InternalCopy: cannot copy type %s(%d)",
456            Tok2Cmdname(source->rtyp),source->rtyp);
457#endif
458  }
459  return NULL;
460}
461
462void sleftv::Copy(leftv source)
463{
464  memset(this,0,sizeof(*this));
465  rtyp=source->Typ();
466  void *d=source->Data();
467  if(!errorreported)
468  switch (rtyp)
469  {
470    case INTVEC_CMD:
471    case INTMAT_CMD:
472      data=(void *)ivCopy((intvec *)d);
473      break;
474    case MATRIX_CMD:
475      data=(void *)mpCopy((matrix)d);
476      break;
477    case IDEAL_CMD:
478    case MODUL_CMD:
479      data= (void *)idCopy((ideal)d);
480      break;
481    case STRING_CMD:
482      data= (void *)mstrdup((char *)d);
483      break;
484    case POINTER_CMD:
485      data=d;
486      break;
487    case PROC_CMD:
488      data= (void *)piCopy((procinfov) d);
489      break;
490    case POLY_CMD:
491    case VECTOR_CMD:
492      data= (void *)pCopy((poly)d);
493      break;
494    case INT_CMD:
495      data= d;
496      break;
497    case NUMBER_CMD:
498      data= (void *)nCopy((number)d);
499      break;
500    case MAP_CMD:
501      data= (void *)maCopy((map)d);
502      break;
503    case LIST_CMD:
504      data= (void *)lCopy((lists)d);
505      break;
506    case LINK_CMD:
507      data = (void *)slCopy((si_link)d);
508      break;
509    case RING_CMD:
510    case QRING_CMD:
511      {
512        if (d!=NULL)
513        {
514          ring r=(ring)d;
515          r->ref++;
516          data=d;
517        } 
518        else
519        {
520          WerrorS("invalid ring description");
521        } 
522        break;
523      }
524    case RESOLUTION_CMD:
525      data=(void*)syCopy((syStrategy)d);
526      break;
527#ifdef TEST
528    case DEF_CMD:
529    case NONE:
530      break; /* error recovery: do nothing */
531    //case COMMAND:
532    default:
533      Warn("Copy: cannot copy type %s(%d)",Tok2Cmdname(rtyp),rtyp);
534#endif
535  }
536  flag=source->flag;
537  if ((source->attribute!=NULL)||(source->e!=NULL))
538    attribute=source->CopyA();
539  if (source->next!=NULL)
540  {
541    next=(leftv)Alloc(sizeof(sleftv));
542    next->Copy(source->next);
543  }
544}
545
546void * sleftv::CopyD(int t)
547{
548  if (iiCheckRing(t))
549     return NULL;
550  if ((rtyp!=IDHDL)&&(e==NULL))
551  {
552    void *x=data;
553    if (rtyp==VNOETHER) x=(void *)pCopy(ppNoether);
554    else if (rtyp==LIB_CMD)
555      x=(void *)mstrdup((char *)Data());
556    else if ((rtyp==VMINPOLY)&& (currRing->minpoly!=NULL)&&(currRing->ch<2))
557      x=(void *)nCopy(currRing->minpoly);
558    data=NULL;
559    return x;
560  }
561  void *d=Data();
562  if (!errorreported) return slInternalCopy(this,t,d,e);
563  return NULL;
564}
565
566void * sleftv::CopyD()
567{
568  if ((rtyp!=IDHDL)&&(e==NULL)
569  &&(rtyp!=VNOETHER)&&(rtyp!=LIB_CMD)&&(rtyp!=VMINPOLY))
570  {
571    void *x=data;
572    data=NULL;
573    return x;
574  }
575  return CopyD(Typ());
576}
577
578attr sleftv::CopyA()
579{
580  attr *a=Attribute();
581  if ((a!=NULL) && (*a!=NULL))
582    return (*a)->Copy();
583  return NULL; 
584}
585
586char *  sleftv::String(void *d)
587{
588#ifdef SIQ
589  if (rtyp==COMMAND)
590  {
591    ::Print("##command %d\n",((command)data)->op);
592    if (((command)data)->arg1.rtyp!=0)
593      ((command)data)->arg1.Print(NULL,2);
594    if (((command)data)->arg2.rtyp!=0)
595      ((command)data)->arg2.Print(NULL,2);
596    if (((command)data)->arg3.rtyp==0)
597      ((command)data)->arg3.Print(NULL,2);
598    PrintS("##end\n");
599    return mstrdup("");
600  }
601#endif
602  if (d==NULL) d=Data();
603  if (!errorreported)
604  {
605    /* create a string, which may be freed by FreeL
606    * leave the switch with return
607    * or with break, which copies the string s*/
608    char *s;
609    const char *n;
610    if (name!=NULL) n=name;
611    else n=sNoName;
612    switch (Typ())
613    {
614      case INT_CMD:
615        s=(char *)AllocL(MAX_INT_LEN+2);
616        sprintf(s,"%d",(int)d);
617        return s;
618      case STRING_CMD:
619        return (char *)CopyD(STRING_CMD);
620      case POLY_CMD:
621      case VECTOR_CMD:
622        s = pString((poly)d);
623        break;
624      case NUMBER_CMD:
625        StringSetS("");
626        if ((rtyp==IDHDL)&&(IDTYP((idhdl)data)==NUMBER_CMD))
627        {
628          nWrite(IDNUMBER((idhdl)data));
629        }
630        else if (rtyp==NUMBER_CMD)
631        {
632          number n=(number)data;
633          nWrite(n);
634          data=(char *)n;
635        }
636        else if((rtyp==VMINPOLY)&&(currRing->ch>2)&&(currRing->P==1))
637        {
638          nfShowMipo();
639        }
640        else
641        {
642          number n=nCopy((number)d);
643          nWrite(n);
644          nDelete(&n);
645        }
646        s = StringAppend("");
647        break;
648      case MATRIX_CMD:
649        s= iiStringMatrix((matrix)d,2);
650        break;
651      case MODUL_CMD:
652      case IDEAL_CMD:
653      case MAP_CMD:
654        s= iiStringMatrix((matrix)d,1);
655        break;
656      case INTVEC_CMD:
657      case INTMAT_CMD:
658      {
659        intvec *v=(intvec *)d;
660        return v->String();
661      }
662      case RING_CMD:
663      case QRING_CMD:
664      {
665        return rString((ring)d);
666      } 
667      default:
668        #ifdef TEST
669        ::Print("String:unknown type %s(%d)", Tok2Cmdname(Typ()),Typ());
670        #endif
671        return NULL;
672    } /* end switch: (Typ()) */
673    return mstrdup(s);
674  }
675  return NULL;
676}
677
678int  sleftv::Typ()
679{
680  if (e==NULL)
681  {
682    switch (rtyp)
683    {
684      case IDHDL:
685        return IDTYP((idhdl)data);
686#ifdef SRING
687      case VALTVARS:
688#endif
689      case VECHO:
690      case VPAGELENGTH:
691      case VPRINTLEVEL:
692      case VCOLMAX:
693      case VTIMER:
694#ifdef HAVE_RTIMER
695      case VRTIMER:
696#endif         
697      case VOICE:
698      case VMAXDEG:
699      case VMAXMULT:
700      case TRACE:
701      case VSHORTOUT:
702        return INT_CMD;
703      case LIB_CMD:
704        return STRING_CMD; 
705      case VMINPOLY:
706        return NUMBER_CMD;
707      case VNOETHER:
708        return POLY_CMD;
709      //case COMMAND:
710      //  return COMMAND;
711      default:
712        return rtyp;
713    }
714  }
715  int r=0;
716  int t=rtyp;
717  if (t==IDHDL) t=IDTYP((idhdl)data);
718  switch (t)
719  {
720    case INTVEC_CMD:
721    case INTMAT_CMD:
722      r=INT_CMD;
723      break;
724    case IDEAL_CMD:
725    case MATRIX_CMD:
726    case MAP_CMD:
727      r=POLY_CMD;
728      break;
729    case MODUL_CMD:
730      r=VECTOR_CMD;
731      break;
732    case STRING_CMD:
733      r=STRING_CMD;
734      break;
735    case LIST_CMD:
736    {
737      lists l;
738      if (rtyp==IDHDL) l=IDLIST((idhdl)data);
739      else             l=(lists)data;
740      if ((0<e->start)&&(e->start<=l->nr+1))
741      {
742        l->m[e->start-1].e=e->next;
743        r=l->m[e->start-1].Typ();
744        l->m[e->start-1].e=NULL;
745      }
746      else
747      {
748        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
749        r=NONE;
750      }
751      break;
752    }
753    default:
754      Werror("cannot index type %d",t);
755  }
756  return r;
757}
758
759int  sleftv::LTyp()
760{
761  lists l=NULL;
762  int r;
763  if (rtyp==LIST_CMD)
764    l=(lists)data;
765  else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
766    l=IDLIST((idhdl)data);
767  else
768    return Typ();
769  //if (l!=NULL)
770  {
771    if ((e!=NULL) && (e->next!=NULL))
772    {
773      if ((0<e->start)&&(e->start<=l->nr+1))
774      {
775        l->m[e->start-1].e=e->next;
776        r=l->m[e->start-1].LTyp();
777        l->m[e->start-1].e=NULL;
778      }
779      else
780      {
781        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
782        r=NONE;
783      }
784      return r;
785    }
786    return LIST_CMD;
787  }
788  return Typ();
789}
790
791void * sleftv::Data()
792{
793  if (iiCheckRing(rtyp))
794     return NULL;
795  if (e==NULL)
796  {
797    switch (rtyp)
798    {
799#ifdef SRING
800      case VALTVARS:   return (void *)pAltVars;
801#endif
802      case VECHO:      return (void *)si_echo;
803      case VPAGELENGTH:return (void *)pagelength;
804      case VPRINTLEVEL:return (void *)printlevel;
805      case VCOLMAX:    return (void *)colmax;
806      case VTIMER:     return (void *)getTimer();
807#ifdef HAVE_RTIMER
808      case VRTIMER:    return (void *)getRTimer();
809#endif
810      case VOICE:      return (void *)(myynest+1);
811      case VMAXDEG:    return (void *)Kstd1_deg;
812      case VMAXMULT:   return (void *)Kstd1_mu;
813      case TRACE:      return (void *)traceit;
814      case VSHORTOUT:  return (void *)pShortOut;
815      case VMINPOLY:   if ((currRing->minpoly!=NULL)&&(currRing->ch<2))
816                       /* Q(a), Fp(a), but not GF(q) */
817                         return (void *)currRing->minpoly;
818                       else
819                         return (void *)nNULL;
820      case VNOETHER:   return (void *) ppNoether;
821      case LIB_CMD:    {
822                         idhdl h = ggetid( "LIB" );
823                         if(h==NULL) return (void *)sNoName;
824                         return IDSTRING(h);
825                       } 
826      case IDHDL:
827        return IDDATA((idhdl)data);
828      case POINTER_CMD:
829        return IDDATA((idhdl)data);
830      case COMMAND:
831        //return NULL;
832      default:
833        return data;
834    }
835  }
836  /* e != NULL : */
837  int t=rtyp;
838  void *d=data;
839  if (t==IDHDL)
840  {
841    t=((idhdl)data)->typ;
842    d=IDDATA((idhdl)data);
843  }
844  if (iiCheckRing(t))
845    return NULL;
846  char *r=NULL;
847  switch (t)
848  {
849    case INTVEC_CMD:
850    {
851      intvec *iv=(intvec *)d;
852      if ((e->start<1)||(e->start>iv->length()))
853      {
854        if (!errorreported)
855          Werror("wrong range[%d] in intvec(%d)",e->start,iv->length());
856      }
857      else
858        r=(char *)((*iv)[e->start-1]);
859      break;
860    }
861    case INTMAT_CMD:
862    {
863      intvec *iv=(intvec *)d;
864      if ((e->start<1)
865         ||(e->start>iv->rows())
866         ||(e->next->start<1)
867         ||(e->next->start>iv->cols()))
868      {
869        if (!errorreported)
870        Werror("wrong range[%d,%d] in intmat(%dx%d)",e->start,e->next->start,
871                                                     iv->rows(),iv->cols());
872      }
873      else
874        r=(char *)(IMATELEM((*iv),e->start,e->next->start));
875      break;
876    }
877    case IDEAL_CMD:
878    case MODUL_CMD:
879    case MAP_CMD:
880    {
881      ideal I=(ideal)d;
882      if ((e->start<1)||(e->start>IDELEMS(I)))
883      {
884        if (!errorreported)
885          Werror("wrong range[%d] in ideal/module(%d)",e->start,IDELEMS(I));
886      }
887      else
888        r=(char *)I->m[e->start-1];
889      break;
890    }
891    case STRING_CMD:
892    {
893      r=(char *)AllocL(2);
894      if ((e->start>0)&& (e->start<=(int)strlen((char *)d)))
895      {
896        r[0]=*(((char *)d)+e->start-1);
897        r[1]='\0';
898      }
899      else
900      {
901        r[0]='\0';
902      }
903      break;
904    }
905    case MATRIX_CMD:
906    {
907      if ((e->start<1)
908         ||(e->start>MATROWS((matrix)d))
909         ||(e->next->start<1)
910         ||(e->next->start>MATCOLS((matrix)d)))
911      {
912        if (!errorreported)
913          Werror("wrong range[%d,%d] in intmat(%dx%d)",e->start,e->next->start,
914                                                     MATROWS((matrix)d),MATCOLS((matrix)d));
915      }
916      else
917        r=(char *)MATELEM((matrix)d,e->start,e->next->start);
918      break;
919    }
920    case LIST_CMD:
921    {
922      lists l=(lists)d;
923      int i=e->start-1;
924      if ((0<=i)&&(i<=l->nr))
925      {
926        l->m[e->start-1].e=e->next;
927        r=(char *)l->m[i].Data();
928        l->m[e->start-1].e=NULL;
929      }
930      else //if (!errorreported)
931        Werror("wrong range[%d] in list(%d)",e->start,l->nr+1);
932      break;
933    }
934#ifdef TEST
935    default:
936      Werror("cannot index type %s(%d)",Tok2Cmdname(t),t);
937#endif
938  }
939  return r;
940}
941
942attr * sleftv::Attribute()
943{
944  if (e==NULL) return &attribute;
945  if ((rtyp==LIST_CMD)
946  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD)))
947  {
948    leftv v=LData();
949    return &(v->attribute);
950  }
951  return NULL;
952}
953
954leftv sleftv::LData()
955{
956  if (e!=NULL)
957  {
958    lists l=NULL;
959
960    if (rtyp==LIST_CMD)
961      l=(lists)data;
962    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
963      l=IDLIST((idhdl)data);
964    if (l!=NULL)
965    {
966      if ((0>=e->start)||(e->start>l->nr+1))
967        return NULL;
968      if (e->next!=NULL)
969      {
970        l->m[e->start-1].e=e->next;
971        leftv r=l->m[e->start-1].LData();
972        l->m[e->start-1].e=NULL;
973        return r;
974      }
975      return &(l->m[e->start-1]);
976    }
977  }
978  return this;
979}
980
981leftv sleftv::LHdl()
982{
983  if (e!=NULL)
984  {
985    lists l=NULL;
986
987    if (rtyp==LIST_CMD)
988      l=(lists)data;
989    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
990      l=IDLIST((idhdl)data);
991    if (l!=NULL)
992    {
993      if ((0>=e->start)||(e->start>l->nr+1))
994        return NULL;
995      if (e->next!=NULL)
996      {
997        l->m[e->start-1].e=e->next;
998        leftv r=l->m[e->start-1].LHdl();
999        l->m[e->start-1].e=NULL;
1000        return r;
1001      }
1002      return &(l->m[e->start-1]);
1003    }
1004  }
1005  return this;
1006}
1007
1008BOOLEAN assumeStdFlag(leftv h)
1009{
1010  if ((h->e!=NULL)&&(h->LTyp()==LIST_CMD))
1011  {
1012    return assumeStdFlag(h->LData());
1013  }
1014  if (!hasFlag(h,FLAG_STD))
1015  {
1016    if (!TEST_VERB_NSB)
1017      Warn("%s is no standardbasis",h->Name());
1018    return FALSE;
1019  }
1020  return TRUE;
1021}
1022
1023/*2
1024* transforms a name (as an string created by AllocL or mstrdup)
1025* into an expression (sleftv), deletes the string
1026* utility for grammar and iparith
1027*/
1028extern BOOLEAN noringvars;
1029void syMake(leftv v,char * id)
1030{
1031  /* resolv an identifier: (to DEF_CMD, if siq>0)
1032  * 1) reserved id: done by scanner
1033  * 2) `basering`
1034  * 3) existing identifier, local
1035  * 4) ringvar, local ring
1036  * 5) existing identifier, global
1037  * 6) monom (resp. number), local ring: consisting of:
1038  * 6') ringvar, global ring
1039  * 6'') monom (resp. number), local ring
1040  * 7) monom (resp. number), non-local ring
1041  * 8) basering
1042  * 9) `_`
1043  * 10) everything else is of type 0
1044  */
1045#ifdef TEST
1046  if ((*id<' ')||(*id>(char)126))
1047  {
1048    Print("wrong id :%s:\n",id);
1049  }
1050#endif
1051  memset(v,0,sizeof(sleftv));
1052#ifdef SIQ
1053  if (siq<=0)
1054#endif
1055  {
1056    idhdl h=NULL;
1057    if (!isdigit(id[0]))
1058    {
1059      if (strcmp(id,"basering")==0)
1060      {
1061        if (currRingHdl!=NULL)
1062        {
1063          if (id!=IDID(currRingHdl)) FreeL((ADDRESS)id);
1064          v->rtyp = IDHDL;
1065          v->data = (char *)currRingHdl;
1066          v->name = IDID(currRingHdl);
1067          v->flag = IDFLAG(currRingHdl);
1068          return;
1069        }
1070        else
1071        {
1072          v->name = id;
1073          return; /* undefined */
1074        }
1075      }
1076      h=ggetid(id);
1077      /* 3) existing identifier, local */
1078      if ((h!=NULL) && (IDLEV(h)==myynest))
1079      {
1080        if (id!=IDID(h)) FreeL((ADDRESS)id);
1081        v->rtyp = IDHDL;
1082        v->data = (char *)h;
1083        v->flag = IDFLAG(h);
1084        v->name = IDID(h);
1085        v->attribute=IDATTR(h);
1086        return;
1087      }
1088    }
1089    /* 4. local ring: ringvar */
1090    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1091    {
1092      int vnr;
1093      if ((vnr=rIsRingVar(id))>=0)
1094      {
1095        poly p=pOne();
1096        pSetExp(p,vnr+1,1);
1097        pSetm(p);
1098        v->data = (void *)p;
1099        v->name = id;
1100        v->rtyp = POLY_CMD;
1101        return;
1102      }
1103    }
1104    /* 5. existing identifier, global */
1105    if (h!=NULL)
1106    {
1107      if (id!=IDID(h)) FreeL((ADDRESS)id);
1108      v->rtyp = IDHDL;
1109      v->data = (char *)h;
1110      v->flag = IDFLAG(h);
1111      v->name = IDID(h);
1112      v->attribute=IDATTR(h);
1113      return;
1114    }
1115    /* 6. local ring: number/poly */
1116    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1117    {
1118      BOOLEAN ok=FALSE;
1119      poly p = (!noringvars) ? pmInit(id,ok) : (poly)NULL;
1120      if (ok)
1121      {
1122        if (p==NULL)
1123        {
1124          v->data = (void *)nInit(0);
1125          v->rtyp = NUMBER_CMD;
1126          FreeL((ADDRESS)id);
1127        }
1128        else
1129        if (pIsConstant(p))
1130        {
1131          v->data = pGetCoeff(p);
1132          pGetCoeff(p)=NULL;
1133          pFree1(p);
1134          v->rtyp = NUMBER_CMD;
1135          v->name = id;
1136        }
1137        else
1138        {
1139          v->data = p;
1140          v->rtyp = POLY_CMD;
1141          v->name = id;
1142        }
1143        return;
1144      }
1145    }
1146    /* 7. non-local ring: number/poly */
1147    {
1148      BOOLEAN ok=FALSE;
1149      poly p = ((currRingHdl!=NULL)&&(!noringvars)&&(IDLEV(currRingHdl)!=myynest))
1150               /* ring required */  /* not in decl */    /* already in case 4/6 */
1151                     ? pmInit(id,ok) : (poly)NULL;
1152      if (ok)
1153      {
1154        if (p==NULL)
1155        {
1156          v->data = (void *)nInit(0);
1157          v->rtyp = NUMBER_CMD;
1158          FreeL((ADDRESS)id);
1159        }
1160        else
1161        if (pIsConstant(p))
1162        {
1163          v->data = pGetCoeff(p);
1164          pGetCoeff(p)=NULL;
1165          pFree1(p);
1166          v->rtyp = NUMBER_CMD;
1167          v->name = id;
1168        }
1169        else
1170        {
1171          v->data = p;
1172          v->rtyp = POLY_CMD;
1173          v->name = id;
1174        }
1175        return;
1176      }
1177    }
1178    /* 8. basering ? */
1179    if ((myynest>1)&&(currRingHdl!=NULL))
1180    {
1181      if (strcmp(id,IDID(currRingHdl))==0)
1182      {
1183        if (IDID(currRingHdl)!=id) FreeL((ADDRESS)id);
1184        v->rtyp=IDHDL;
1185        v->data=currRingHdl;
1186        v->name=IDID(currRingHdl);
1187        v->attribute=IDATTR(currRingHdl);
1188        return;
1189      }
1190    }
1191  }
1192#ifdef SIQ
1193  else
1194    v->rtyp=DEF_CMD;
1195#endif
1196  /* 9: _ */
1197  if (strcmp(id,"_")==0)
1198  {
1199    FreeL((ADDRESS)id);
1200    v->Copy(&sLastPrinted);
1201  }
1202  else
1203  {
1204    /* 10: everything else */
1205    /* v->rtyp = UNKNOWN;*/
1206    v->name = id;
1207  }
1208}
1209
1210int sleftv::Eval()
1211{
1212  BOOLEAN nok=FALSE;
1213  leftv nn=next;
1214  next=NULL;
1215  if(rtyp==IDHDL)
1216  {
1217    int t=Typ();
1218    if (t!=PROC_CMD)
1219    {
1220      void *d=CopyD(t);
1221      data=d;
1222      rtyp=t;
1223      name=NULL;
1224      e=NULL;
1225    }
1226  }
1227  else if (rtyp==COMMAND)
1228  {
1229    command d=(command)data;
1230    if(d->op==PROC_CMD) //assume d->argc==2
1231    {
1232      char *what=(char *)(d->arg1.Data());
1233      idhdl h=ggetid(what);
1234      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1235      {
1236        nok=d->arg2.Eval();
1237        if(!nok)
1238        {
1239          leftv r=iiMake_proc(h,&d->arg2);
1240          if (r!=NULL)
1241            memcpy(this,r,sizeof(sleftv));
1242          else
1243            nok=TRUE;
1244        }
1245      }
1246      else nok=TRUE;
1247    }
1248    else if (d->op=='=') //assume d->argc==2
1249    {
1250      char *n=d->arg1.name;
1251      if (n!=NULL)
1252      {
1253        nok=d->arg2.Eval();
1254        if (!nok)
1255        {
1256          int save_typ=d->arg1.rtyp;
1257          mmTestLP(n);
1258          syMake(&d->arg1,n); //assume  type of arg1==DEF_CMD
1259          mmTestLP(d->arg1.name);
1260          if (d->arg1.rtyp==IDHDL)
1261          {
1262            n=mstrdup(IDID((idhdl)d->arg1.data));
1263            killhdl((idhdl)d->arg1.data);
1264            d->arg1.data=NULL;
1265            d->arg1.name=n;
1266          }
1267          //d->arg1.rtyp=DEF_CMD;
1268          sleftv t;
1269          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1270          if ((BEGIN_RING<d->arg2.rtyp)&&(d->arg2.rtyp<END_RING)
1271          /*&&(QRING_CMD!=d->arg2.rtyp)*/)
1272            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1273          else
1274            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&IDROOT);
1275          memcpy(&d->arg1,&t,sizeof(sleftv));
1276          mmTestLP(d->arg1.name);
1277          nok=nok||iiAssign(&d->arg1,&d->arg2);
1278          mmTestLP(d->arg1.name);
1279          if (!nok)
1280          {
1281            memset(&d->arg1,0,sizeof(sleftv));
1282            this->CleanUp();
1283            memset(this,0,sizeof(sleftv));
1284            rtyp=NONE;
1285          }
1286        }
1287      }
1288      else nok=TRUE;
1289    }
1290    else if (d->argc==1)
1291    {
1292      nok=d->arg1.Eval();
1293      nok=nok||iiExprArith1(this,&d->arg1,d->op);
1294    }
1295    else if(d->argc==2)
1296    {
1297      nok=d->arg1.Eval();
1298      nok=nok||d->arg2.Eval();
1299      nok=nok||iiExprArith2(this,&d->arg1,d->op,&d->arg2);
1300    }
1301    else if(d->argc==3)
1302    {
1303      nok=d->arg1.Eval();
1304      nok=nok||d->arg2.Eval();
1305      nok=nok||d->arg3.Eval();
1306      nok=nok||iiExprArith3(this,d->op,&d->arg1,&d->arg2,&d->arg3);
1307    }
1308    else if(d->argc!=0)
1309    {
1310      nok=d->arg1.Eval();
1311      nok=nok||iiExprArithM(this,&d->arg1,d->op);
1312    }
1313    else // d->argc == 0
1314    {
1315      nok = iiExprArithM(this, NULL, d->op);
1316    }
1317  }
1318  else if (((rtyp==0)||(rtyp==DEF_CMD))
1319    &&(name!=NULL))
1320  {
1321     syMake(this,name);
1322  }
1323#ifdef MDEBUG
1324  switch(Typ())
1325  {
1326    case NUMBER_CMD:
1327#ifdef LDEBUG
1328      nTest((number)Data());
1329#endif
1330      break;
1331    case POLY_CMD:
1332      pTest((poly)Data());
1333      break;
1334    case IDEAL_CMD:
1335    case MODUL_CMD:
1336    case MATRIX_CMD:
1337      {
1338        ideal id=(ideal)Data();
1339        mmTest(id,sizeof(*id));
1340        int i=id->ncols*id->nrows-1;
1341        for(;i>=0;i--) pTest(id->m[i]);
1342      }
1343      break;
1344  }
1345#endif
1346  if (nn!=NULL) nok=nok||nn->Eval();
1347  next=nn;
1348  return nok;
1349}
1350
Note: See TracBrowser for help on using the repository browser.