source: git/Singular/subexpr.cc @ 6d281ac

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