source: git/Singular/subexpr.cc @ a3432c

spielwiese
Last change on this file since a3432c was a3432c, checked in by Hans Schönemann <hannes@…>, 26 years ago
minor optimizations git-svn-id: file:///usr/local/Singular/svn/trunk@2519 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 29.7 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 ((rtyp!=IDHDL)&&(e==NULL))
549  {
550    if (iiCheckRing(t)) return NULL;
551    void *x=data;
552    if (rtyp==VNOETHER) x=(void *)pCopy(ppNoether);
553    else if (rtyp==LIB_CMD)
554      x=(void *)mstrdup((char *)Data());
555    else if ((rtyp==VMINPOLY)&& (currRing->minpoly!=NULL)&&(currRing->ch<2))
556      x=(void *)nCopy(currRing->minpoly);
557    data=NULL;
558    return x;
559  }
560  void *d=Data(); // will also do a iiCheckRing
561  if ((!errorreported) && (d!=NULL)) return slInternalCopy(this,t,d,e);
562  return NULL;
563}
564
565void * sleftv::CopyD()
566{
567  if ((rtyp!=IDHDL)&&(e==NULL)
568  &&(rtyp!=VNOETHER)&&(rtyp!=LIB_CMD)&&(rtyp!=VMINPOLY))
569  {
570    void *x=data;
571    data=NULL;
572    return x;
573  }
574  return CopyD(Typ());
575}
576
577attr sleftv::CopyA()
578{
579  attr *a=Attribute();
580  if ((a!=NULL) && (*a!=NULL))
581    return (*a)->Copy();
582  return NULL;
583}
584
585char *  sleftv::String(void *d)
586{
587#ifdef SIQ
588  if (rtyp==COMMAND)
589  {
590    ::Print("##command %d\n",((command)data)->op);
591    if (((command)data)->arg1.rtyp!=0)
592      ((command)data)->arg1.Print(NULL,2);
593    if (((command)data)->arg2.rtyp!=0)
594      ((command)data)->arg2.Print(NULL,2);
595    if (((command)data)->arg3.rtyp==0)
596      ((command)data)->arg3.Print(NULL,2);
597    PrintS("##end\n");
598    return mstrdup("");
599  }
600#endif
601  if (d==NULL) d=Data();
602  if (!errorreported)
603  {
604    /* create a string, which may be freed by FreeL
605    * leave the switch with return
606    * or with break, which copies the string s*/
607    char *s;
608    const char *n;
609    if (name!=NULL) n=name;
610    else n=sNoName;
611    switch (Typ())
612    {
613      case INT_CMD:
614        s=(char *)AllocL(MAX_INT_LEN+2);
615        sprintf(s,"%d",(int)d);
616        return s;
617      case STRING_CMD:
618        return (char *)CopyD(STRING_CMD);
619      case POLY_CMD:
620      case VECTOR_CMD:
621        s = pString((poly)d);
622        break;
623      case NUMBER_CMD:
624        StringSetS("");
625        if ((rtyp==IDHDL)&&(IDTYP((idhdl)data)==NUMBER_CMD))
626        {
627          nWrite(IDNUMBER((idhdl)data));
628        }
629        else if (rtyp==NUMBER_CMD)
630        {
631          number n=(number)data;
632          nWrite(n);
633          data=(char *)n;
634        }
635        else if((rtyp==VMINPOLY)&&(currRing->ch>2)&&(currRing->P==1))
636        {
637          nfShowMipo();
638        }
639        else
640        {
641          number n=nCopy((number)d);
642          nWrite(n);
643          nDelete(&n);
644        }
645        s = StringAppend("");
646        break;
647      case MATRIX_CMD:
648        s= iiStringMatrix((matrix)d,2);
649        break;
650      case MODUL_CMD:
651      case IDEAL_CMD:
652      case MAP_CMD:
653        s= iiStringMatrix((matrix)d,1);
654        break;
655      case INTVEC_CMD:
656      case INTMAT_CMD:
657      {
658        intvec *v=(intvec *)d;
659        return v->String();
660      }
661      case RING_CMD:
662      case QRING_CMD:
663      {
664        return rString((ring)d);
665      }
666      default:
667        #ifdef TEST
668        ::Print("String:unknown type %s(%d)", Tok2Cmdname(Typ()),Typ());
669        #endif
670        return NULL;
671    } /* end switch: (Typ()) */
672    return mstrdup(s);
673  }
674  return NULL;
675}
676
677int  sleftv::Typ()
678{
679  if (e==NULL)
680  {
681    switch (rtyp)
682    {
683      case IDHDL:
684        return IDTYP((idhdl)data);
685#ifdef SRING
686      case VALTVARS:
687#endif
688      case VECHO:
689      case VPAGELENGTH:
690      case VPRINTLEVEL:
691      case VCOLMAX:
692      case VTIMER:
693#ifdef HAVE_RTIMER
694      case VRTIMER:
695#endif
696      case VOICE:
697      case VMAXDEG:
698      case VMAXMULT:
699      case TRACE:
700      case VSHORTOUT:
701        return INT_CMD;
702      case LIB_CMD:
703        return STRING_CMD;
704      case VMINPOLY:
705        return NUMBER_CMD;
706      case VNOETHER:
707        return POLY_CMD;
708      //case COMMAND:
709      //  return COMMAND;
710      default:
711        return rtyp;
712    }
713  }
714  int r=0;
715  int t=rtyp;
716  if (t==IDHDL) t=IDTYP((idhdl)data);
717  switch (t)
718  {
719    case INTVEC_CMD:
720    case INTMAT_CMD:
721      r=INT_CMD;
722      break;
723    case IDEAL_CMD:
724    case MATRIX_CMD:
725    case MAP_CMD:
726      r=POLY_CMD;
727      break;
728    case MODUL_CMD:
729      r=VECTOR_CMD;
730      break;
731    case STRING_CMD:
732      r=STRING_CMD;
733      break;
734    case LIST_CMD:
735    {
736      lists l;
737      if (rtyp==IDHDL) l=IDLIST((idhdl)data);
738      else             l=(lists)data;
739      if ((0<e->start)&&(e->start<=l->nr+1))
740      {
741        l->m[e->start-1].e=e->next;
742        r=l->m[e->start-1].Typ();
743        l->m[e->start-1].e=NULL;
744      }
745      else
746      {
747        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
748        r=NONE;
749      }
750      break;
751    }
752    default:
753      Werror("cannot index type %d",t);
754  }
755  return r;
756}
757
758int  sleftv::LTyp()
759{
760  lists l=NULL;
761  int r;
762  if (rtyp==LIST_CMD)
763    l=(lists)data;
764  else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
765    l=IDLIST((idhdl)data);
766  else
767    return Typ();
768  //if (l!=NULL)
769  {
770    if ((e!=NULL) && (e->next!=NULL))
771    {
772      if ((0<e->start)&&(e->start<=l->nr+1))
773      {
774        l->m[e->start-1].e=e->next;
775        r=l->m[e->start-1].LTyp();
776        l->m[e->start-1].e=NULL;
777      }
778      else
779      {
780        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
781        r=NONE;
782      }
783      return r;
784    }
785    return LIST_CMD;
786  }
787  return Typ();
788}
789
790void * sleftv::Data()
791{
792  if (rtyp!=IDHDL && iiCheckRing(rtyp))
793     return NULL;
794  if (e==NULL)
795  {
796    switch (rtyp)
797    {
798#ifdef SRING
799      case VALTVARS:   return (void *)pAltVars;
800#endif
801      case VECHO:      return (void *)si_echo;
802      case VPAGELENGTH:return (void *)pagelength;
803      case VPRINTLEVEL:return (void *)printlevel;
804      case VCOLMAX:    return (void *)colmax;
805      case VTIMER:     return (void *)getTimer();
806#ifdef HAVE_RTIMER
807      case VRTIMER:    return (void *)getRTimer();
808#endif
809      case VOICE:      return (void *)(myynest+1);
810      case VMAXDEG:    return (void *)Kstd1_deg;
811      case VMAXMULT:   return (void *)Kstd1_mu;
812      case TRACE:      return (void *)traceit;
813      case VSHORTOUT:  return (void *)pShortOut;
814      case VMINPOLY:   if ((currRing->minpoly!=NULL)&&(currRing->ch<2))
815                       /* Q(a), Fp(a), but not GF(q) */
816                         return (void *)currRing->minpoly;
817                       else
818                         return (void *)nNULL;
819      case VNOETHER:   return (void *) ppNoether;
820      case LIB_CMD:    {
821                         idhdl h = ggetid( "LIB" );
822                         if(h==NULL) return (void *)sNoName;
823                         return IDSTRING(h);
824                       }
825      case IDHDL:
826        return IDDATA((idhdl)data);
827      case POINTER_CMD:
828        return IDDATA((idhdl)data);
829      case COMMAND:
830        //return NULL;
831      default:
832        return data;
833    }
834  }
835  /* e != NULL : */
836  int t=rtyp;
837  void *d=data;
838  if (t==IDHDL)
839  {
840    t=((idhdl)data)->typ;
841    d=IDDATA((idhdl)data);
842  }
843  if (iiCheckRing(t))
844    return NULL;
845  char *r=NULL;
846  switch (t)
847  {
848    case INTVEC_CMD:
849    {
850      intvec *iv=(intvec *)d;
851      if ((e->start<1)||(e->start>iv->length()))
852      {
853        if (!errorreported)
854          Werror("wrong range[%d] in intvec(%d)",e->start,iv->length());
855      }
856      else
857        r=(char *)((*iv)[e->start-1]);
858      break;
859    }
860    case INTMAT_CMD:
861    {
862      intvec *iv=(intvec *)d;
863      if ((e->start<1)
864         ||(e->start>iv->rows())
865         ||(e->next->start<1)
866         ||(e->next->start>iv->cols()))
867      {
868        if (!errorreported)
869        Werror("wrong range[%d,%d] in intmat(%dx%d)",e->start,e->next->start,
870                                                     iv->rows(),iv->cols());
871      }
872      else
873        r=(char *)(IMATELEM((*iv),e->start,e->next->start));
874      break;
875    }
876    case IDEAL_CMD:
877    case MODUL_CMD:
878    case MAP_CMD:
879    {
880      ideal I=(ideal)d;
881      if ((e->start<1)||(e->start>IDELEMS(I)))
882      {
883        if (!errorreported)
884          Werror("wrong range[%d] in ideal/module(%d)",e->start,IDELEMS(I));
885      }
886      else
887        r=(char *)I->m[e->start-1];
888      break;
889    }
890    case STRING_CMD:
891    {
892      r=(char *)AllocL(2);
893      if ((e->start>0)&& (e->start<=(int)strlen((char *)d)))
894      {
895        r[0]=*(((char *)d)+e->start-1);
896        r[1]='\0';
897      }
898      else
899      {
900        r[0]='\0';
901      }
902      break;
903    }
904    case MATRIX_CMD:
905    {
906      if ((e->start<1)
907         ||(e->start>MATROWS((matrix)d))
908         ||(e->next->start<1)
909         ||(e->next->start>MATCOLS((matrix)d)))
910      {
911        if (!errorreported)
912          Werror("wrong range[%d,%d] in intmat(%dx%d)",e->start,e->next->start,
913                                                     MATROWS((matrix)d),MATCOLS((matrix)d));
914      }
915      else
916        r=(char *)MATELEM((matrix)d,e->start,e->next->start);
917      break;
918    }
919    case LIST_CMD:
920    {
921      lists l=(lists)d;
922      int i=e->start-1;
923      if ((0<=i)&&(i<=l->nr))
924      {
925        l->m[e->start-1].e=e->next;
926        r=(char *)l->m[i].Data();
927        l->m[e->start-1].e=NULL;
928      }
929      else //if (!errorreported)
930        Werror("wrong range[%d] in list(%d)",e->start,l->nr+1);
931      break;
932    }
933#ifdef TEST
934    default:
935      Werror("cannot index type %s(%d)",Tok2Cmdname(t),t);
936#endif
937  }
938  return r;
939}
940
941attr * sleftv::Attribute()
942{
943  if (e==NULL) return &attribute;
944  if ((rtyp==LIST_CMD)
945  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD)))
946  {
947    leftv v=LData();
948    return &(v->attribute);
949  }
950  return NULL;
951}
952
953leftv sleftv::LData()
954{
955  if (e!=NULL)
956  {
957    lists l=NULL;
958
959    if (rtyp==LIST_CMD)
960      l=(lists)data;
961    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
962      l=IDLIST((idhdl)data);
963    if (l!=NULL)
964    {
965      if ((0>=e->start)||(e->start>l->nr+1))
966        return NULL;
967      if (e->next!=NULL)
968      {
969        l->m[e->start-1].e=e->next;
970        leftv r=l->m[e->start-1].LData();
971        l->m[e->start-1].e=NULL;
972        return r;
973      }
974      return &(l->m[e->start-1]);
975    }
976  }
977  return this;
978}
979
980leftv sleftv::LHdl()
981{
982  if (e!=NULL)
983  {
984    lists l=NULL;
985
986    if (rtyp==LIST_CMD)
987      l=(lists)data;
988    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
989      l=IDLIST((idhdl)data);
990    if (l!=NULL)
991    {
992      if ((0>=e->start)||(e->start>l->nr+1))
993        return NULL;
994      if (e->next!=NULL)
995      {
996        l->m[e->start-1].e=e->next;
997        leftv r=l->m[e->start-1].LHdl();
998        l->m[e->start-1].e=NULL;
999        return r;
1000      }
1001      return &(l->m[e->start-1]);
1002    }
1003  }
1004  return this;
1005}
1006
1007BOOLEAN assumeStdFlag(leftv h)
1008{
1009  if ((h->e!=NULL)&&(h->LTyp()==LIST_CMD))
1010  {
1011    return assumeStdFlag(h->LData());
1012  }
1013  if (!hasFlag(h,FLAG_STD))
1014  {
1015    if (!TEST_VERB_NSB)
1016      Warn("%s is no standardbasis",h->Name());
1017    return FALSE;
1018  }
1019  return TRUE;
1020}
1021
1022/*2
1023* transforms a name (as an string created by AllocL or mstrdup)
1024* into an expression (sleftv), deletes the string
1025* utility for grammar and iparith
1026*/
1027extern BOOLEAN noringvars;
1028void syMake(leftv v,char * id)
1029{
1030  /* resolv an identifier: (to DEF_CMD, if siq>0)
1031  * 1) reserved id: done by scanner
1032  * 2) `basering`
1033  * 3) existing identifier, local
1034  * 4) ringvar, local ring
1035  * 5) existing identifier, global
1036  * 6) monom (resp. number), local ring: consisting of:
1037  * 6') ringvar, global ring
1038  * 6'') monom (resp. number), local ring
1039  * 7) monom (resp. number), non-local ring
1040  * 8) basering
1041  * 9) `_`
1042  * 10) everything else is of type 0
1043  */
1044#ifdef TEST
1045  if ((*id<' ')||(*id>(char)126))
1046  {
1047    Print("wrong id :%s:\n",id);
1048  }
1049#endif
1050  memset(v,0,sizeof(sleftv));
1051#ifdef SIQ
1052  if (siq<=0)
1053#endif
1054  {
1055    idhdl h=NULL;
1056    if (!isdigit(id[0]))
1057    {
1058      if (strcmp(id,"basering")==0)
1059      {
1060        if (currRingHdl!=NULL)
1061        {
1062          if (id!=IDID(currRingHdl)) FreeL((ADDRESS)id);
1063          v->rtyp = IDHDL;
1064          v->data = (char *)currRingHdl;
1065          v->name = IDID(currRingHdl);
1066          v->flag = IDFLAG(currRingHdl);
1067          return;
1068        }
1069        else
1070        {
1071          v->name = id;
1072          return; /* undefined */
1073        }
1074      }
1075      h=ggetid(id);
1076      /* 3) existing identifier, local */
1077      if ((h!=NULL) && (IDLEV(h)==myynest))
1078      {
1079        if (id!=IDID(h)) FreeL((ADDRESS)id);
1080        v->rtyp = IDHDL;
1081        v->data = (char *)h;
1082        v->flag = IDFLAG(h);
1083        v->name = IDID(h);
1084        v->attribute=IDATTR(h);
1085        return;
1086      }
1087    }
1088    /* 4. local ring: ringvar */
1089    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1090    {
1091      int vnr;
1092      if ((vnr=rIsRingVar(id))>=0)
1093      {
1094        poly p=pOne();
1095        pSetExp(p,vnr+1,1);
1096        pSetm(p);
1097        v->data = (void *)p;
1098        v->name = id;
1099        v->rtyp = POLY_CMD;
1100        return;
1101      }
1102    }
1103    /* 5. existing identifier, global */
1104    if (h!=NULL)
1105    {
1106      if (id!=IDID(h)) FreeL((ADDRESS)id);
1107      v->rtyp = IDHDL;
1108      v->data = (char *)h;
1109      v->flag = IDFLAG(h);
1110      v->name = IDID(h);
1111      v->attribute=IDATTR(h);
1112      return;
1113    }
1114    /* 6. local ring: number/poly */
1115    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1116    {
1117      BOOLEAN ok=FALSE;
1118      poly p = (!noringvars) ? pmInit(id,ok) : (poly)NULL;
1119      if (ok)
1120      {
1121        if (p==NULL)
1122        {
1123          v->data = (void *)nInit(0);
1124          v->rtyp = NUMBER_CMD;
1125          FreeL((ADDRESS)id);
1126        }
1127        else
1128        if (pIsConstant(p))
1129        {
1130          v->data = pGetCoeff(p);
1131          pGetCoeff(p)=NULL;
1132          pFree1(p);
1133          v->rtyp = NUMBER_CMD;
1134          v->name = id;
1135        }
1136        else
1137        {
1138          v->data = p;
1139          v->rtyp = POLY_CMD;
1140          v->name = id;
1141        }
1142        return;
1143      }
1144    }
1145    /* 7. non-local ring: number/poly */
1146    {
1147      BOOLEAN ok=FALSE;
1148      poly p = ((currRingHdl!=NULL)&&(!noringvars)&&(IDLEV(currRingHdl)!=myynest))
1149               /* ring required */  /* not in decl */    /* already in case 4/6 */
1150                     ? pmInit(id,ok) : (poly)NULL;
1151      if (ok)
1152      {
1153        if (p==NULL)
1154        {
1155          v->data = (void *)nInit(0);
1156          v->rtyp = NUMBER_CMD;
1157          FreeL((ADDRESS)id);
1158        }
1159        else
1160        if (pIsConstant(p))
1161        {
1162          v->data = pGetCoeff(p);
1163          pGetCoeff(p)=NULL;
1164          pFree1(p);
1165          v->rtyp = NUMBER_CMD;
1166          v->name = id;
1167        }
1168        else
1169        {
1170          v->data = p;
1171          v->rtyp = POLY_CMD;
1172          v->name = id;
1173        }
1174        return;
1175      }
1176    }
1177    /* 8. basering ? */
1178    if ((myynest>1)&&(currRingHdl!=NULL))
1179    {
1180      if (strcmp(id,IDID(currRingHdl))==0)
1181      {
1182        if (IDID(currRingHdl)!=id) FreeL((ADDRESS)id);
1183        v->rtyp=IDHDL;
1184        v->data=currRingHdl;
1185        v->name=IDID(currRingHdl);
1186        v->attribute=IDATTR(currRingHdl);
1187        return;
1188      }
1189    }
1190  }
1191#ifdef SIQ
1192  else
1193    v->rtyp=DEF_CMD;
1194#endif
1195  /* 9: _ */
1196  if (strcmp(id,"_")==0)
1197  {
1198    FreeL((ADDRESS)id);
1199    v->Copy(&sLastPrinted);
1200  }
1201  else
1202  {
1203    /* 10: everything else */
1204    /* v->rtyp = UNKNOWN;*/
1205    v->name = id;
1206  }
1207}
1208
1209int sleftv::Eval()
1210{
1211  BOOLEAN nok=FALSE;
1212  leftv nn=next;
1213  next=NULL;
1214  if(rtyp==IDHDL)
1215  {
1216    int t=Typ();
1217    if (t!=PROC_CMD)
1218    {
1219      void *d=CopyD(t);
1220      data=d;
1221      rtyp=t;
1222      name=NULL;
1223      e=NULL;
1224    }
1225  }
1226  else if (rtyp==COMMAND)
1227  {
1228    command d=(command)data;
1229    if(d->op==PROC_CMD) //assume d->argc==2
1230    {
1231      char *what=(char *)(d->arg1.Data());
1232      idhdl h=ggetid(what);
1233      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1234      {
1235        nok=d->arg2.Eval();
1236        if(!nok)
1237        {
1238          leftv r=iiMake_proc(h,&d->arg2);
1239          if (r!=NULL)
1240            memcpy(this,r,sizeof(sleftv));
1241          else
1242            nok=TRUE;
1243        }
1244      }
1245      else nok=TRUE;
1246    }
1247    else if (d->op=='=') //assume d->argc==2
1248    {
1249      char *n=d->arg1.name;
1250      if (n!=NULL)
1251      {
1252        nok=d->arg2.Eval();
1253        if (!nok)
1254        {
1255          int save_typ=d->arg1.rtyp;
1256          mmTestLP(n);
1257          syMake(&d->arg1,n); //assume  type of arg1==DEF_CMD
1258          mmTestLP(d->arg1.name);
1259          if (d->arg1.rtyp==IDHDL)
1260          {
1261            n=mstrdup(IDID((idhdl)d->arg1.data));
1262            killhdl((idhdl)d->arg1.data);
1263            d->arg1.data=NULL;
1264            d->arg1.name=n;
1265          }
1266          //d->arg1.rtyp=DEF_CMD;
1267          sleftv t;
1268          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1269          if ((BEGIN_RING<d->arg2.rtyp)&&(d->arg2.rtyp<END_RING)
1270          /*&&(QRING_CMD!=d->arg2.rtyp)*/)
1271            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1272          else
1273            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&IDROOT);
1274          memcpy(&d->arg1,&t,sizeof(sleftv));
1275          mmTestLP(d->arg1.name);
1276          nok=nok||iiAssign(&d->arg1,&d->arg2);
1277          mmTestLP(d->arg1.name);
1278          if (!nok)
1279          {
1280            memset(&d->arg1,0,sizeof(sleftv));
1281            this->CleanUp();
1282            memset(this,0,sizeof(sleftv));
1283            rtyp=NONE;
1284          }
1285        }
1286      }
1287      else nok=TRUE;
1288    }
1289    else if (d->argc==1)
1290    {
1291      nok=d->arg1.Eval();
1292      nok=nok||iiExprArith1(this,&d->arg1,d->op);
1293    }
1294    else if(d->argc==2)
1295    {
1296      nok=d->arg1.Eval();
1297      nok=nok||d->arg2.Eval();
1298      nok=nok||iiExprArith2(this,&d->arg1,d->op,&d->arg2);
1299    }
1300    else if(d->argc==3)
1301    {
1302      nok=d->arg1.Eval();
1303      nok=nok||d->arg2.Eval();
1304      nok=nok||d->arg3.Eval();
1305      nok=nok||iiExprArith3(this,d->op,&d->arg1,&d->arg2,&d->arg3);
1306    }
1307    else if(d->argc!=0)
1308    {
1309      nok=d->arg1.Eval();
1310      nok=nok||iiExprArithM(this,&d->arg1,d->op);
1311    }
1312    else // d->argc == 0
1313    {
1314      nok = iiExprArithM(this, NULL, d->op);
1315    }
1316  }
1317  else if (((rtyp==0)||(rtyp==DEF_CMD))
1318    &&(name!=NULL))
1319  {
1320     syMake(this,name);
1321  }
1322#ifdef MDEBUG
1323  switch(Typ())
1324  {
1325    case NUMBER_CMD:
1326#ifdef LDEBUG
1327      nTest((number)Data());
1328#endif
1329      break;
1330    case POLY_CMD:
1331      pTest((poly)Data());
1332      break;
1333    case IDEAL_CMD:
1334    case MODUL_CMD:
1335    case MATRIX_CMD:
1336      {
1337        ideal id=(ideal)Data();
1338        mmTest(id,sizeof(*id));
1339        int i=id->ncols*id->nrows-1;
1340        for(;i>=0;i--) pTest(id->m[i]);
1341      }
1342      break;
1343  }
1344#endif
1345  if (nn!=NULL) nok=nok||nn->Eval();
1346  next=nn;
1347  return nok;
1348}
1349
Note: See TracBrowser for help on using the repository browser.