source: git/Singular/subexpr.cc @ 2f12a6f

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