source: git/Singular/subexpr.cc @ a79a128

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