source: git/Singular/subexpr.cc @ 2e7c661

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