source: git/Singular/subexpr.cc @ dfc6b54

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