source: git/Singular/subexpr.cc @ 802a18

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