source: git/Singular/subexpr.cc @ c12cf96

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