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

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