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

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