source: git/Singular/subexpr.cc @ 499bdc

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