source: git/Singular/subexpr.cc @ f82470

spielwiese
Last change on this file since f82470 was f82470, checked in by Olaf Bachmann <obachman@…>, 25 years ago
* string(LINK_CMD); git-svn-id: file:///usr/local/Singular/svn/trunk@2981 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 33.2 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)&&(!rField_is_GF()))
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)&&(rField_is_GF()))
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        case LINK_CMD:
722        {
723          return slString((si_link) d);
724        }
725       
726      default:
727        #ifdef TEST
728        ::Print("String:unknown type %s(%d)", Tok2Cmdname(Typ()),Typ());
729        #endif
730        return NULL;
731    } /* end switch: (Typ()) */
732    return mstrdup(s);
733  }
734  return NULL;
735}
736
737int  sleftv::Typ()
738{
739  if (e==NULL)
740  {
741    switch (rtyp)
742    {
743      case IDHDL:
744        return IDTYP((idhdl)data);
745#ifdef SRING
746      case VALTVARS:
747#endif
748      case VECHO:
749      case VPAGELENGTH:
750      case VPRINTLEVEL:
751      case VCOLMAX:
752      case VTIMER:
753#ifdef HAVE_RTIMER
754      case VRTIMER:
755#endif
756      case VOICE:
757      case VMAXDEG:
758      case VMAXMULT:
759      case TRACE:
760      case VSHORTOUT:
761        return INT_CMD;
762      case LIB_CMD:
763        return STRING_CMD;
764      case VMINPOLY:
765        return NUMBER_CMD;
766      case VNOETHER:
767        return POLY_CMD;
768      //case COMMAND:
769      //  return COMMAND;
770      default:
771        return rtyp;
772    }
773  }
774  int r=0;
775  int t=rtyp;
776  if (t==IDHDL) t=IDTYP((idhdl)data);
777  switch (t)
778  {
779    case INTVEC_CMD:
780    case INTMAT_CMD:
781      r=INT_CMD;
782      break;
783    case IDEAL_CMD:
784    case MATRIX_CMD:
785    case MAP_CMD:
786      r=POLY_CMD;
787      break;
788    case MODUL_CMD:
789      r=VECTOR_CMD;
790      break;
791    case STRING_CMD:
792      r=STRING_CMD;
793      break;
794    case LIST_CMD:
795    {
796      lists l;
797      if (rtyp==IDHDL) l=IDLIST((idhdl)data);
798      else             l=(lists)data;
799      if ((0<e->start)&&(e->start<=l->nr+1))
800      {
801        l->m[e->start-1].e=e->next;
802        r=l->m[e->start-1].Typ();
803        l->m[e->start-1].e=NULL;
804      }
805      else
806      {
807        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
808        r=NONE;
809      }
810      break;
811    }
812    default:
813      Werror("cannot index type %d",t);
814  }
815  return r;
816}
817
818int  sleftv::LTyp()
819{
820  lists l=NULL;
821  int r;
822  if (rtyp==LIST_CMD)
823    l=(lists)data;
824  else if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
825    l=IDLIST((idhdl)data);
826  else
827    return Typ();
828  //if (l!=NULL)
829  {
830    if ((e!=NULL) && (e->next!=NULL))
831    {
832      if ((0<e->start)&&(e->start<=l->nr+1))
833      {
834        l->m[e->start-1].e=e->next;
835        r=l->m[e->start-1].LTyp();
836        l->m[e->start-1].e=NULL;
837      }
838      else
839      {
840        //Warn("out of range: %d not in 1..%d",e->start,l->nr+1);
841        r=NONE;
842      }
843      return r;
844    }
845    return LIST_CMD;
846  }
847  return Typ();
848}
849
850void * sleftv::Data()
851{
852  if (rtyp!=IDHDL && iiCheckRing(rtyp))
853     return NULL;
854  if (e==NULL)
855  {
856    switch (rtyp)
857    {
858#ifdef SRING
859      case VALTVARS:   return (void *)pAltVars;
860#endif
861      case VECHO:      return (void *)si_echo;
862      case VPAGELENGTH:return (void *)pagelength;
863      case VPRINTLEVEL:return (void *)printlevel;
864      case VCOLMAX:    return (void *)colmax;
865      case VTIMER:     return (void *)getTimer();
866#ifdef HAVE_RTIMER
867      case VRTIMER:    return (void *)getRTimer();
868#endif
869      case VOICE:      return (void *)(myynest+1);
870      case VMAXDEG:    return (void *)Kstd1_deg;
871      case VMAXMULT:   return (void *)Kstd1_mu;
872      case TRACE:      return (void *)traceit;
873      case VSHORTOUT:  return (void *)pShortOut;
874      case VMINPOLY:   if ((currRing->minpoly!=NULL)&&(!rField_is_GF()))
875                       /* Q(a), Fp(a), but not GF(q) */
876                         return (void *)currRing->minpoly;
877                       else
878                         return (void *)nNULL;
879      case VNOETHER:   return (void *) ppNoether;
880      case LIB_CMD:    {
881                         idhdl h = ggetid( "LIB" );
882                         if(h==NULL) return (void *)sNoName;
883                         return IDSTRING(h);
884                       }
885      case IDHDL:
886        return IDDATA((idhdl)data);
887      case POINTER_CMD:
888        return IDDATA((idhdl)data);
889      case COMMAND:
890        //return NULL;
891      default:
892        return data;
893    }
894  }
895  /* e != NULL : */
896  int t=rtyp;
897  void *d=data;
898  if (t==IDHDL)
899  {
900    t=((idhdl)data)->typ;
901    d=IDDATA((idhdl)data);
902  }
903  if (iiCheckRing(t))
904    return NULL;
905  char *r=NULL;
906  switch (t)
907  {
908    case INTVEC_CMD:
909    {
910      intvec *iv=(intvec *)d;
911      if ((e->start<1)||(e->start>iv->length()))
912      {
913        if (!errorreported)
914          Werror("wrong range[%d] in intvec(%d)",e->start,iv->length());
915      }
916      else
917        r=(char *)((*iv)[e->start-1]);
918      break;
919    }
920    case INTMAT_CMD:
921    {
922      intvec *iv=(intvec *)d;
923      if ((e->start<1)
924         ||(e->start>iv->rows())
925         ||(e->next->start<1)
926         ||(e->next->start>iv->cols()))
927      {
928        if (!errorreported)
929        Werror("wrong range[%d,%d] in intmat(%dx%d)",e->start,e->next->start,
930                                                     iv->rows(),iv->cols());
931      }
932      else
933        r=(char *)(IMATELEM((*iv),e->start,e->next->start));
934      break;
935    }
936    case IDEAL_CMD:
937    case MODUL_CMD:
938    case MAP_CMD:
939    {
940      ideal I=(ideal)d;
941      if ((e->start<1)||(e->start>IDELEMS(I)))
942      {
943        if (!errorreported)
944          Werror("wrong range[%d] in ideal/module(%d)",e->start,IDELEMS(I));
945      }
946      else
947        r=(char *)I->m[e->start-1];
948      break;
949    }
950    case STRING_CMD:
951    {
952      r=(char *)AllocL(2);
953      if ((e->start>0)&& (e->start<=(int)strlen((char *)d)))
954      {
955        r[0]=*(((char *)d)+e->start-1);
956        r[1]='\0';
957      }
958      else
959      {
960        r[0]='\0';
961      }
962      break;
963    }
964    case MATRIX_CMD:
965    {
966      if ((e->start<1)
967         ||(e->start>MATROWS((matrix)d))
968         ||(e->next->start<1)
969         ||(e->next->start>MATCOLS((matrix)d)))
970      {
971        if (!errorreported)
972          Werror("wrong range[%d,%d] in intmat(%dx%d)",e->start,e->next->start,
973                                                     MATROWS((matrix)d),MATCOLS((matrix)d));
974      }
975      else
976        r=(char *)MATELEM((matrix)d,e->start,e->next->start);
977      break;
978    }
979    case LIST_CMD:
980    {
981      lists l=(lists)d;
982      int i=e->start-1;
983      if ((0<=i)&&(i<=l->nr))
984      {
985        l->m[e->start-1].e=e->next;
986        r=(char *)l->m[i].Data();
987        l->m[e->start-1].e=NULL;
988      }
989      else //if (!errorreported)
990        Werror("wrong range[%d] in list(%d)",e->start,l->nr+1);
991      break;
992    }
993#ifdef TEST
994    default:
995      Werror("cannot index type %s(%d)",Tok2Cmdname(t),t);
996#endif
997  }
998  return r;
999}
1000
1001attr * sleftv::Attribute()
1002{
1003  if (e==NULL) return &attribute;
1004  if ((rtyp==LIST_CMD)
1005  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD)))
1006  {
1007    leftv v=LData();
1008    return &(v->attribute);
1009  }
1010  return NULL;
1011}
1012
1013leftv sleftv::LData()
1014{
1015  if (e!=NULL)
1016  {
1017    lists l=NULL;
1018
1019    if (rtyp==LIST_CMD)
1020      l=(lists)data;
1021    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1022      l=IDLIST((idhdl)data);
1023    if (l!=NULL)
1024    {
1025      if ((0>=e->start)||(e->start>l->nr+1))
1026        return NULL;
1027      if (e->next!=NULL)
1028      {
1029        l->m[e->start-1].e=e->next;
1030        leftv r=l->m[e->start-1].LData();
1031        l->m[e->start-1].e=NULL;
1032        return r;
1033      }
1034      return &(l->m[e->start-1]);
1035    }
1036  }
1037  return this;
1038}
1039
1040leftv sleftv::LHdl()
1041{
1042  if (e!=NULL)
1043  {
1044    lists l=NULL;
1045
1046    if (rtyp==LIST_CMD)
1047      l=(lists)data;
1048    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
1049      l=IDLIST((idhdl)data);
1050    if (l!=NULL)
1051    {
1052      if ((0>=e->start)||(e->start>l->nr+1))
1053        return NULL;
1054      if (e->next!=NULL)
1055      {
1056        l->m[e->start-1].e=e->next;
1057        leftv r=l->m[e->start-1].LHdl();
1058        l->m[e->start-1].e=NULL;
1059        return r;
1060      }
1061      return &(l->m[e->start-1]);
1062    }
1063  }
1064  return this;
1065}
1066
1067BOOLEAN assumeStdFlag(leftv h)
1068{
1069  if ((h->e!=NULL)&&(h->LTyp()==LIST_CMD))
1070  {
1071    return assumeStdFlag(h->LData());
1072  }
1073  if (!hasFlag(h,FLAG_STD))
1074  {
1075    if (!TEST_VERB_NSB)
1076      Warn("%s is no standardbasis",h->Name());
1077    return FALSE;
1078  }
1079  return TRUE;
1080}
1081
1082/*2
1083* transforms a name (as an string created by AllocL or mstrdup)
1084* into an expression (sleftv), deletes the string
1085* utility for grammar and iparith
1086*/
1087extern BOOLEAN noringvars;
1088void syMake(leftv v,char * id, idhdl packhdl)
1089{
1090  /* resolv an identifier: (to DEF_CMD, if siq>0)
1091  * 1) reserved id: done by scanner
1092  * 2) `basering`
1093  * 3) existing identifier, local
1094  * 4) ringvar, local ring
1095  * 5) existing identifier, global
1096  * 6) monom (resp. number), local ring: consisting of:
1097  * 6') ringvar, global ring
1098  * 6'') monom (resp. number), local ring
1099  * 7) monom (resp. number), non-local ring
1100  * 8) basering
1101  * 9) `_`
1102  * 10) everything else is of type 0
1103  */
1104#ifdef TEST
1105  if ((*id<' ')||(*id>(char)126))
1106  {
1107    Print("wrong id :%s:\n",id);
1108  }
1109#endif
1110  memset(v,0,sizeof(sleftv));
1111#ifdef HAVE_NAMESPACES
1112  v->packhdl = NULL;
1113  if(packhdl != NULL)
1114    v->req_packhdl = packhdl;
1115  else v->req_packhdl = namespaceroot->get(namespaceroot->name, 0, TRUE);
1116#endif /* HAVE_NAMESPACES */
1117#ifdef SIQ
1118  if (siq<=0)
1119#endif
1120  {
1121    idhdl h=NULL;
1122    if (!isdigit(id[0]))
1123    {
1124      if (strcmp(id,"basering")==0)
1125      {
1126        if (currRingHdl!=NULL)
1127        {
1128          if (id!=IDID(currRingHdl)) FreeL((ADDRESS)id);
1129          v->rtyp = IDHDL;
1130          v->data = (char *)currRingHdl;
1131          v->name = IDID(currRingHdl);
1132          v->flag = IDFLAG(currRingHdl);
1133          return;
1134        }
1135        else
1136        {
1137          v->name = id;
1138          return; /* undefined */
1139        }
1140      }
1141#ifdef HAVE_NAMESPACES
1142      if (strcmp(id,"Current")==0)
1143      {
1144        h = namespaceroot->get(namespaceroot->name,0, TRUE);
1145        if (id!=IDID(h)) FreeL((ADDRESS)id);
1146        v->rtyp = IDHDL;
1147        v->data = (char *)h;
1148        v->flag = IDFLAG(h);
1149        v->name = IDID(h);
1150        v->attribute=IDATTR(h);
1151        return;
1152      }
1153      if (strcmp(id,"Up")==0)
1154      { namehdl ns=namespaceroot;
1155        if (!ns->isroot) ns=ns->next;
1156        if (id!=ns->name) FreeL((ADDRESS)id);
1157        v->rtyp = NSHDL;
1158        v->data = (char *)ns;
1159        v->name = mstrdup(ns->name);
1160        return;
1161      }
1162      h=ggetid(id, packhdl==NULL ? FALSE : TRUE, &(v->packhdl));
1163      //if(h==NULL) Print("syMake: h is null\n");
1164#else /* HAVE_NAMESPACES */
1165      h=ggetid(id);
1166#endif /* HAVE_NAMESPACES */
1167      /* 3) existing identifier, local */
1168      if ((h!=NULL) && (IDLEV(h)==myynest))
1169      {
1170        if (id!=IDID(h)) FreeL((ADDRESS)id);
1171        v->rtyp = IDHDL;
1172        v->data = (char *)h;
1173        v->flag = IDFLAG(h);
1174        v->name = IDID(h);
1175        v->attribute=IDATTR(h);
1176        return;
1177      }
1178    }
1179    /* 4. local ring: ringvar */
1180    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1181    {
1182      int vnr;
1183      if ((vnr=rIsRingVar(id))>=0)
1184      {
1185        poly p=pOne();
1186        pSetExp(p,vnr+1,1);
1187        pSetm(p);
1188        v->data = (void *)p;
1189        v->name = id;
1190        v->rtyp = POLY_CMD;
1191        return;
1192      }
1193    }
1194    /* 5. existing identifier, global */
1195    if (h!=NULL)
1196    {
1197      if (id!=IDID(h)) FreeL((ADDRESS)id);
1198      v->rtyp = IDHDL;
1199      v->data = (char *)h;
1200      v->flag = IDFLAG(h);
1201      v->name = IDID(h);
1202      v->attribute=IDATTR(h);
1203      return;
1204    }
1205    /* 6. local ring: number/poly */
1206    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1207    {
1208      BOOLEAN ok=FALSE;
1209      poly p = (!noringvars) ? pmInit(id,ok) : (poly)NULL;
1210      if (ok)
1211      {
1212        if (p==NULL)
1213        {
1214          v->data = (void *)nInit(0);
1215          v->rtyp = NUMBER_CMD;
1216          FreeL((ADDRESS)id);
1217        }
1218        else
1219        if (pIsConstant(p))
1220        {
1221          v->data = pGetCoeff(p);
1222          pGetCoeff(p)=NULL;
1223          pFree1(p);
1224          v->rtyp = NUMBER_CMD;
1225          v->name = id;
1226        }
1227        else
1228        {
1229          v->data = p;
1230          v->rtyp = POLY_CMD;
1231          v->name = id;
1232        }
1233        return;
1234      }
1235    }
1236    /* 7. non-local ring: number/poly */
1237    {
1238      BOOLEAN ok=FALSE;
1239      poly p = ((currRingHdl!=NULL)&&(!noringvars)&&(IDLEV(currRingHdl)!=myynest))
1240               /* ring required */  /* not in decl */    /* already in case 4/6 */
1241                     ? pmInit(id,ok) : (poly)NULL;
1242      if (ok)
1243      {
1244        if (p==NULL)
1245        {
1246          v->data = (void *)nInit(0);
1247          v->rtyp = NUMBER_CMD;
1248          FreeL((ADDRESS)id);
1249        }
1250        else
1251        if (pIsConstant(p))
1252        {
1253          v->data = pGetCoeff(p);
1254          pGetCoeff(p)=NULL;
1255          pFree1(p);
1256          v->rtyp = NUMBER_CMD;
1257          v->name = id;
1258        }
1259        else
1260        {
1261          v->data = p;
1262          v->rtyp = POLY_CMD;
1263          v->name = id;
1264        }
1265        return;
1266      }
1267    }
1268    /* 8. basering ? */
1269    if ((myynest>1)&&(currRingHdl!=NULL))
1270    {
1271      if (strcmp(id,IDID(currRingHdl))==0)
1272      {
1273        if (IDID(currRingHdl)!=id) FreeL((ADDRESS)id);
1274        v->rtyp=IDHDL;
1275        v->data=currRingHdl;
1276        v->name=IDID(currRingHdl);
1277        v->attribute=IDATTR(currRingHdl);
1278        return;
1279      }
1280    }
1281  }
1282#ifdef SIQ
1283  else
1284    v->rtyp=DEF_CMD;
1285#endif
1286  /* 9: _ */
1287  if (strcmp(id,"_")==0)
1288  {
1289    FreeL((ADDRESS)id);
1290    v->Copy(&sLastPrinted);
1291  }
1292  else
1293  {
1294    /* 10: everything else */
1295    /* v->rtyp = UNKNOWN;*/
1296    v->name = id;
1297  }
1298}
1299
1300int sleftv::Eval()
1301{
1302  BOOLEAN nok=FALSE;
1303  leftv nn=next;
1304  next=NULL;
1305  if(rtyp==IDHDL)
1306  {
1307    int t=Typ();
1308    if (t!=PROC_CMD)
1309    {
1310      void *d=CopyD(t);
1311      data=d;
1312      rtyp=t;
1313      name=NULL;
1314      e=NULL;
1315    }
1316  }
1317  else if (rtyp==COMMAND)
1318  {
1319    command d=(command)data;
1320    if(d->op==PROC_CMD) //assume d->argc==2
1321    {
1322      char *what=(char *)(d->arg1.Data());
1323      idhdl h=ggetid(what);
1324      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1325      {
1326        nok=d->arg2.Eval();
1327        if(!nok)
1328        {
1329#ifdef HAVE_NAMESPACES
1330          leftv r=iiMake_proc(h,(sleftv*)NULL,&d->arg2);
1331#else /* HAVE_NAMESPACES */
1332          leftv r=iiMake_proc(h,&d->arg2);
1333#endif /* HAVE_NAMESPACES */
1334          if (r!=NULL)
1335            memcpy(this,r,sizeof(sleftv));
1336          else
1337            nok=TRUE;
1338        }
1339      }
1340      else nok=TRUE;
1341    }
1342    else if (d->op=='=') //assume d->argc==2
1343    {
1344      if ((d->arg1.rtyp!=IDHDL)&&(d->arg1.rtyp!=DEF_CMD))
1345      {
1346        nok=d->arg1.Eval();
1347      }
1348      if (!nok)
1349      {
1350        char *n=d->arg1.name;
1351        nok=(n == NULL) || d->arg2.Eval();
1352        if (!nok)
1353        {
1354          int save_typ=d->arg1.rtyp;
1355          mmTestLP(n);
1356          if (d->arg1.rtyp!=IDHDL)
1357#ifdef HAVE_NAMESPACES
1358            syMake(&d->arg1,n, d->arg1.req_packhdl); //assume  type of arg1==DEF_CMD
1359#else
1360          syMake(&d->arg1,n);
1361#endif         
1362          mmTestLP(d->arg1.name);
1363          if (d->arg1.rtyp==IDHDL)
1364          {
1365            n=mstrdup(IDID((idhdl)d->arg1.data));
1366            killhdl((idhdl)d->arg1.data);
1367            d->arg1.data=NULL;
1368            d->arg1.name=n;
1369          }
1370          //d->arg1.rtyp=DEF_CMD;
1371          sleftv t;
1372          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1373          if ((BEGIN_RING<d->arg2.rtyp)&&(d->arg2.rtyp<END_RING)
1374          /*&&(QRING_CMD!=d->arg2.rtyp)*/)
1375            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1376          else
1377            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&IDROOT);
1378          memcpy(&d->arg1,&t,sizeof(sleftv));
1379          mmTestLP(d->arg1.name);
1380          nok=nok||iiAssign(&d->arg1,&d->arg2);
1381          mmTestLP(d->arg1.name);
1382          if (!nok)
1383          {
1384            memset(&d->arg1,0,sizeof(sleftv));
1385            this->CleanUp();
1386            memset(this,0,sizeof(sleftv));
1387            rtyp=NONE;
1388          }
1389        }
1390      }
1391      else nok=TRUE;
1392    }
1393    else if (d->argc==1)
1394    {
1395      nok=d->arg1.Eval();
1396      nok=nok||iiExprArith1(this,&d->arg1,d->op);
1397    }
1398    else if(d->argc==2)
1399    {
1400      nok=d->arg1.Eval();
1401      nok=nok||d->arg2.Eval();
1402      nok=nok||iiExprArith2(this,&d->arg1,d->op,&d->arg2);
1403    }
1404    else if(d->argc==3)
1405    {
1406      nok=d->arg1.Eval();
1407      nok=nok||d->arg2.Eval();
1408      nok=nok||d->arg3.Eval();
1409      nok=nok||iiExprArith3(this,d->op,&d->arg1,&d->arg2,&d->arg3);
1410    }
1411    else if(d->argc!=0)
1412    {
1413      nok=d->arg1.Eval();
1414      nok=nok||iiExprArithM(this,&d->arg1,d->op);
1415    }
1416    else // d->argc == 0
1417    {
1418      nok = iiExprArithM(this, NULL, d->op);
1419    }
1420  }
1421  else if (((rtyp==0)||(rtyp==DEF_CMD))
1422    &&(name!=NULL))
1423  {
1424     syMake(this,name);
1425  }
1426#ifdef MDEBUG
1427  switch(Typ())
1428  {
1429    case NUMBER_CMD:
1430#ifdef LDEBUG
1431      nTest((number)Data());
1432#endif
1433      break;
1434    case POLY_CMD:
1435      pTest((poly)Data());
1436      break;
1437    case IDEAL_CMD:
1438    case MODUL_CMD:
1439    case MATRIX_CMD:
1440      {
1441        ideal id=(ideal)Data();
1442        mmTest(id,sizeof(*id));
1443        int i=id->ncols*id->nrows-1;
1444        for(;i>=0;i--) pTest(id->m[i]);
1445      }
1446      break;
1447  }
1448#endif
1449  if (nn!=NULL) nok=nok||nn->Eval();
1450  next=nn;
1451  return nok;
1452}
1453
1454char *iiSleftv2name(leftv v)
1455{
1456#ifdef HAVE_NAMESPACES
1457  char *name;
1458  if(v->packhdl != NULL) {
1459    name = (char *)AllocL(strlen(v->name) + strlen(IDID(v->packhdl)) + 3);
1460    sprintf(name, "%s::%s", IDID(v->packhdl), v->name);
1461    return(name);
1462  }
1463  else
1464  {
1465    return(v->name);
1466  }
1467#else /* HAVE_NAMESPACES */
1468  return(v->name);
1469#endif /* HAVE_NAMESPACES */
1470}
Note: See TracBrowser for help on using the repository browser.