source: git/Singular/subexpr.cc @ 4b2155

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