source: git/Singular/subexpr.cc @ 4c001a

spielwiese
Last change on this file since 4c001a was 4c001a, checked in by Olaf Bachmann <obachman@…>, 27 years ago
Merged fixes from 1-0-0 release git-svn-id: file:///usr/local/Singular/svn/trunk@358 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 28.9 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 "subexpr.h"
37
38sleftv     sLastPrinted;
39const char sNoName[]="_";
40#ifdef SIQ
41BOOLEAN siq=FALSE;
42#endif
43
44void sleftv::Set(int val)
45{
46  Init();
47  rtyp = INT_CMD;
48  data = (void *)val;
49}
50
51int sleftv::listLength()
52{
53  int n = 1;
54  leftv sl = next;
55  while (sl!=NULL)
56  {
57    n++;
58    sl=sl->next;
59  }
60  return n;
61}
62
63void sleftv::Print(leftv store, int spaces)
64{
65  int  t=Typ();
66  if (errorreported) return;
67#ifdef SIQ
68  if (rtyp==COMMAND)
69  {
70    command c=(command)data;
71    char ch[2];
72    ch[0]=c->op;ch[1]='\0';
73    char *s=ch;
74    if (c->op>127) s=Tok2Cmdname(c->op);
75    ::Print("##command %d(%s), %d args\n",
76      c->op, s, c->argc);
77    if (c->argc>0)
78      c->arg1.Print(NULL,spaces+2);
79    if(c->argc<4)
80    {
81      if (c->argc>1)
82        c->arg2.Print(NULL,spaces+2);
83      if (c->argc>2)
84        c->arg3.Print(NULL,spaces+2);
85    }
86    PrintS("##end");
87  }
88  else
89#endif
90  {
91    if ((t/*Typ()*/!=PROC_CMD)
92    && (t/*Typ()*/!=BINARY_CMD))
93    {
94      const char *n=Name();
95      char *s;
96      void *d=Data();
97      if (errorreported)
98        return;
99      if ((store!=NULL)&&(store!=this))
100        store->CleanUp();
101
102      switch (t /*=Typ()*/)
103      {
104        case UNKNOWN:
105        case DEF_CMD:
106        case PACKAGE_CMD:
107        #ifdef HAVE_DLD
108        case BINARY_CMD:
109        #endif
110          ::Print("%-*.*s`%s`",spaces,spaces," ",n);
111          break;
112        case NONE:
113          return;
114        case INTVEC_CMD:
115        case INTMAT_CMD:
116          ((intvec *)d)->show(t,spaces);
117          break;
118        case RING_CMD:
119        case QRING_CMD:
120          ::Print("%-*.*s",spaces,spaces," ");
121          rWrite((ring)d);
122          break;
123        case MATRIX_CMD:
124          iiWriteMatrix((matrix)d,n,2,spaces);
125          break;
126        case MAP_CMD:
127        case MODUL_CMD:
128        case IDEAL_CMD:
129          iiWriteMatrix((matrix)d,n,1,spaces);
130          break;
131        case POLY_CMD:
132        case VECTOR_CMD:
133          ::Print("%-*.*s",spaces,spaces," ");
134          pWrite0((poly)d);
135          break;
136        case STRING_CMD:
137          ::Print("%-*.*s%s",spaces,spaces," ",(char *)d);
138          break;
139       case INT_CMD:
140          ::Print("%-*.*s%d",spaces,spaces," ",(int)d);
141          break;
142       case LINK_CMD:
143          {
144            si_link l=(si_link)d;
145            ::Print("%-*.*s// type : %s\n",spaces,spaces," ",
146                    slStatus(l, "type"));
147            ::Print("%-*.*s// mode : %s\n",spaces,spaces," ",
148                    slStatus(l, "mode"));
149            ::Print("%-*.*s// name : %s\n",spaces,spaces," ",
150                    slStatus(l, "name"));
151            ::Print("%-*.*s// open : %s\n",spaces,spaces," ",
152                    slStatus(l, "open"));
153            ::Print("%-*.*s// read : %s\n",spaces,spaces," ",
154                    slStatus(l, "read"));
155            ::Print("%-*.*s// write: %s",spaces,spaces," ",
156                    slStatus(l, "write"));
157          break;
158          }
159        case NUMBER_CMD:
160          s=String(d);
161          if (s==NULL) return;
162          ::Print("%-*.*s",spaces,spaces," ");
163          PrintS(s);
164          FreeL((ADDRESS)s);
165          break;
166        case LIST_CMD:
167        {
168          lists l=(lists)d;
169          if (l->nr<0)
170             ::Print("%-*.*sempty list\n",spaces,spaces," ");
171          else
172          {
173            int i=0;
174            for (;i<=l->nr;i++)
175            {
176              if (l->m[i].rtyp!=DEF_CMD)
177              {
178                ::Print("%-*.*s[%d]:\n",spaces,spaces," ",i+1);
179                l->m[i].Print(NULL,spaces+3);
180              }
181            }
182          }
183          break;
184        }
185#ifdef TEST
186        default:
187          ::Print("Print:unknown type %s(%d)", Tok2Cmdname(t),t);
188#endif
189      } /* end switch: (Typ()) */
190    }
191  }
192  if (next!=NULL)
193  {
194    if (t==COMMAND) PrintLn();
195    else if (t!=LIST_CMD) PrintS(" ");
196    next->Print(NULL,spaces);
197  }
198  else if (t!=LIST_CMD)
199  {
200    PrintLn();
201  } 
202#ifdef SIQ
203  if (rtyp!=COMMAND)
204#endif
205  {
206    if ((store!=NULL)
207    && (store!=this)
208    && (t/*Typ()*/!=LINK_CMD)
209    && (t/*Typ()*/!=RING_CMD)
210    && (t/*Typ()*/!=QRING_CMD)
211    && (t/*Typ()*/!=PACKAGE_CMD)
212    && (t/*Typ()*/!=PROC_CMD)
213    && (t/*Typ()*/!=DEF_CMD)
214    )
215    {
216      store->rtyp=t/*Typ()*/;
217      store->data=CopyD();
218    }
219  }
220}
221
222void sleftv::CleanUp()
223{
224  if ((name!=NULL) && (name!=sNoName) && (rtyp!=IDHDL))
225  {
226    //::Print("free %x (%s)\n",name,name);
227    FreeL((ADDRESS)name);
228  }
229  name=NULL;
230  if (data!=NULL)
231  {
232    switch (rtyp)
233    {
234      case INTVEC_CMD:
235      case INTMAT_CMD:
236        delete (intvec *)data;
237        break;
238      case MAP_CMD:
239        FreeL((ADDRESS)((map)data)->preimage);
240        ((map)data)->preimage=NULL;
241        // no break: kill the image as an ideal
242      case MATRIX_CMD:
243      case MODUL_CMD:
244      case IDEAL_CMD:
245        idDelete((ideal *)(&data));
246        break;
247      case STRING_CMD:
248        FreeL((ADDRESS)data);
249        break;
250      case POLY_CMD:
251      case VECTOR_CMD:
252        pDelete((poly *)(&data));
253        break;
254      case NUMBER_CMD:
255        nDelete((number *)(&data));
256        break;
257      case LIST_CMD:
258        ((lists)data)->Clean();
259        break;
260      case QRING_CMD:
261      case RING_CMD:
262        rKill((ring)data);
263        break;
264      case LINK_CMD:
265        slKill((si_link)data);
266        break;
267      case COMMAND:
268      {
269        command cmd=(command)data;
270        if (cmd->arg1.rtyp!=0) cmd->arg1.CleanUp();
271        if (cmd->arg2.rtyp!=0) cmd->arg2.CleanUp();
272        if (cmd->arg3.rtyp!=0) cmd->arg3.CleanUp();
273        Free((ADDRESS)data,sizeof(ip_command));
274        break;
275      }
276#ifdef TEST
277      // the following types do not take memory
278      // or are not copied
279      case IDHDL:
280      case PACKAGE_CMD:
281      case ANY_TYPE:
282#ifdef SRING
283      case VALTVARS:
284#endif
285      case VECHO:
286      case VPAGELENGTH:
287      case VPRINTLEVEL:
288      case VCOLMAX:
289      case VTIMER:
290#ifdef HAVE_RTIMER
291        case VRTIMER:
292#endif         
293      case VOICE:
294      case VMAXDEG:
295      case VMAXMULT:
296      case TRACE:
297      case VSHORTOUT:
298      case VNOETHER:
299      case VMINPOLY:
300      case 0:
301      case INT_CMD:
302        break;
303      default:
304#ifdef SIC
305        if (rtyp<SIC_MASK)
306#endif
307        ::Print("CleanUp: unknown type %d\n",rtyp);  /* DEBUG */
308#endif
309    } /* end switch: (rtyp) */
310    data=NULL;
311  }
312  if (attribute!=NULL)
313  {
314    switch (rtyp)
315    {
316      case PACKAGE_CMD:
317      case IDHDL:
318      case ANY_TYPE:
319#ifdef SRING
320      case VALTVARS:
321#endif
322      case VECHO:
323      case VPAGELENGTH:
324      case VPRINTLEVEL:
325      case VCOLMAX:
326      case VTIMER:
327#ifdef HAVE_RTIMER
328        case VRTIMER:
329#endif         
330      case VOICE:
331      case VMAXDEG:
332      case VMAXMULT:
333      case TRACE:
334      case VSHORTOUT:
335      case VNOETHER:
336      case VMINPOLY:
337      case 0:
338        attribute=NULL;
339        break;
340      default:
341      {
342        attr t;
343        while (attribute!=NULL)
344        {
345          t=attribute->next;
346          attribute->kill();
347          attribute=t;
348        }
349      }
350    }
351  }
352  Subexpr h;
353  while (e!=NULL)
354  {
355    h=e->next;
356    Free((ADDRESS)e,sizeof(*e));
357    e=h;
358  }
359  rtyp=NONE;
360  if (next!=NULL)
361  {
362    next->name=NULL;
363    next->CleanUp();
364    Free((ADDRESS)next,sizeof(sleftv));
365    next=NULL;
366  }
367}
368
369void * slInternalCopy(leftv source)
370{
371  void *d=source->data;
372  switch (source->rtyp)
373  {
374    case INTVEC_CMD:
375    case INTMAT_CMD:
376      return (void *)ivCopy((intvec *)d);
377    case MATRIX_CMD:
378      return (void *)mpCopy((matrix)d);
379    case IDEAL_CMD:
380    case MODUL_CMD:
381      return  (void *)idCopy((ideal)d);
382    case STRING_CMD:
383    case PROC_CMD:
384      return  (void *)mstrdup((char *)d);
385    case POLY_CMD:
386    case VECTOR_CMD:
387      return  (void *)pCopy((poly)d);
388    case INT_CMD:
389      return  d;
390    case NUMBER_CMD:
391      return  (void *)nCopy((number)d);
392    case MAP_CMD:
393      return  (void *)maCopy((map)d);
394    case LIST_CMD:
395      return  (void *)lCopy((lists)d);
396    case LINK_CMD:
397      return (void *)slCopy((si_link) d);
398    case RING_CMD:
399    case QRING_CMD:
400      {
401        ring r=(ring)d;
402        r->ref++;
403        return d;
404      }
405#ifdef TEST
406    case DEF_CMD:
407    case NONE:
408      break; /* error recovery: do nothing */
409    //case COMMAND:
410    default:
411      Warn("InternalCopy: cannot copy type %s(%d)",
412            Tok2Cmdname(source->rtyp),source->rtyp);
413#endif
414  }
415  return NULL;
416}
417
418void sleftv::Copy(leftv source)
419{
420  memset(this,0,sizeof(*this));
421#ifdef SIC
422  if (source->rtyp>SIC_MASK)
423  {
424    rtyp=source->rtyp;
425    return;
426  }
427  else
428#endif
429  rtyp=source->Typ();
430  void *d=source->Data();
431  if(!errorreported)
432  switch (rtyp)
433  {
434    case INTVEC_CMD:
435    case INTMAT_CMD:
436      data=(void *)ivCopy((intvec *)d);
437      break;
438    case MATRIX_CMD:
439      data=(void *)mpCopy((matrix)d);
440      break;
441    case IDEAL_CMD:
442    case MODUL_CMD:
443      data= (void *)idCopy((ideal)d);
444      break;
445    case STRING_CMD:
446      data= (void *)mstrdup((char *)d);
447      break;
448    case PROC_CMD:
449      data= (void *)mstrdup((char *)d);
450      break;
451    case POLY_CMD:
452    case VECTOR_CMD:
453      data= (void *)pCopy((poly)d);
454      break;
455    case INT_CMD:
456      data= d;
457      break;
458    case NUMBER_CMD:
459      data= (void *)nCopy((number)d);
460      break;
461    case MAP_CMD:
462      data= (void *)maCopy((map)d);
463      break;
464    case LIST_CMD:
465      data= (void *)lCopy((lists)d);
466      break;
467    case LINK_CMD:
468      data = (void *)slCopy((si_link) d);
469      break;
470    case RING_CMD:
471    case QRING_CMD:
472      {
473        ring r=(ring)d;
474        r->ref++;
475        data=d;
476        break;
477      }
478#ifdef TEST
479    case DEF_CMD:
480    case NONE:
481      break; /* error recovery: do nothing */
482    //case COMMAND:
483    default:
484      Warn("Copy: cannot copy type %s(%d)",Tok2Cmdname(rtyp),rtyp);
485#endif
486  }
487  flag=source->flag;
488  if ((source->attribute!=NULL)||(source->e!=NULL))
489    attribute=source->CopyA();
490  if (source->next!=NULL)
491  {
492    next=(leftv)Alloc(sizeof(sleftv));
493    next->Copy(source->next);
494  }
495}
496
497void * sleftv::CopyD(int t)
498{
499  if (iiCheckRing(t))
500     return NULL;
501  if ((rtyp!=IDHDL)&&(e==NULL))
502  {
503    void *x=data;
504    if (rtyp==VNOETHER) x=(void *)pCopy(ppNoether);
505    else if ((rtyp==VMINPOLY)&& (currRing->minpoly!=NULL)&&(currRing->ch<2))
506      x=(void *)nCopy(currRing->minpoly);
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 RING_CMD:
558    case QRING_CMD:
559      {
560        ring r=(ring)d;
561        r->ref++;
562        return d;
563      }
564    case 0:
565    case DEF_CMD:
566      break;
567#ifdef TEST
568    //case COMMAND:
569    default:
570      Warn("CopyD: cannot copy type %s(%d)",Tok2Cmdname(t),t);
571#endif
572  }
573  return NULL;
574}
575
576void * sleftv::CopyD()
577{
578  if ((rtyp!=IDHDL)&&(e==NULL)
579  &&(rtyp!=VNOETHER)&&(rtyp!=VMINPOLY))
580  {
581    void *x=data;
582    data=NULL;
583    return x;
584  }
585  return CopyD(Typ());
586}
587
588attr sleftv::CopyA()
589{
590  attr *a=Attribute();
591  if ((a!=NULL) && (*a!=NULL))
592    return (*a)->Copy();
593  return NULL; 
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 ((rtyp==LIST_CMD)
947  ||((rtyp==IDHDL)&&(IDTYP((idhdl)data)==LIST_CMD)))
948  {
949    leftv v=LData();
950    return &(v->attribute);
951  }
952  return NULL;
953}
954
955leftv sleftv::LData()
956{
957  if (e!=NULL)
958  {
959    lists l=NULL;
960
961    if (rtyp==LIST_CMD)
962      l=(lists)data;
963    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
964      l=IDLIST((idhdl)data);
965    if (l!=NULL)
966    {
967      if ((0>=e->start)||(e->start>l->nr+1))
968        return NULL;
969      if (e->next!=NULL)
970      {
971        l->m[e->start-1].e=e->next;
972        leftv r=l->m[e->start-1].LData();
973        l->m[e->start-1].e=NULL;
974        return r;
975      }
976      return &(l->m[e->start-1]);
977    }
978  }
979  return this;
980}
981
982leftv sleftv::LHdl()
983{
984  if (e!=NULL)
985  {
986    lists l=NULL;
987
988    if (rtyp==LIST_CMD)
989      l=(lists)data;
990    if ((rtyp==IDHDL)&& (IDTYP((idhdl)data)==LIST_CMD))
991      l=IDLIST((idhdl)data);
992    if (l!=NULL)
993    {
994      if ((0>=e->start)||(e->start>l->nr+1))
995        return NULL;
996      if (e->next!=NULL)
997      {
998        l->m[e->start-1].e=e->next;
999        leftv r=l->m[e->start-1].LHdl();
1000        l->m[e->start-1].e=NULL;
1001        return r;
1002      }
1003      return &(l->m[e->start-1]);
1004    }
1005  }
1006  return this;
1007}
1008
1009BOOLEAN assumeStdFlag(leftv h)
1010{
1011  if ((h->e!=NULL)&&(h->LTyp()==LIST_CMD))
1012  {
1013    return assumeStdFlag(h->LData());
1014  }
1015  if (!hasFlag(h,FLAG_STD))
1016  {
1017    if (!TEST_VERB_NSB)
1018      Warn("%s is no standardbasis",h->Name());
1019    return FALSE;
1020  }
1021  return TRUE;
1022}
1023
1024/*2
1025* transforms a name (as an string created by AllocL or mstrdup)
1026* into an expression (sleftv), deletes the string
1027* utility for grammar and iparith
1028*/
1029extern BOOLEAN noringvars;
1030void syMake(leftv v,char * id)
1031{
1032  /* resolv an identifier: (to DEF_CMD, if siq>0)
1033  * 1) reserved id: done by scanner
1034  * 2) `basering`
1035  * 3) existing identifier, local
1036  * 4) ringvar, local ring
1037  * 5) existing identifier, global
1038  * 6) monom (resp. number), local ring: consisting of:
1039  * 6') ringvar, global ring
1040  * 6'') monom (resp. number), local ring
1041  * 7) monom (resp. number), non-local ring
1042  * 8) basering
1043  * 9) `_`
1044  * 10) everything else is of type 0
1045  */
1046#ifdef TEST
1047  if ((*id<' ')||(*id>(char)126))
1048  {
1049    Print("wrong id :%s:\n",id);
1050  }
1051#endif
1052  memset(v,0,sizeof(sleftv));
1053#ifdef SIQ
1054  if (siq<=0)
1055#endif
1056  {
1057    idhdl h=NULL;
1058    if (!isdigit(id[0]))
1059    {
1060      if (strcmp(id,"basering")==0)
1061      {
1062        if (currRingHdl!=NULL)
1063        {
1064          if (id!=IDID(currRingHdl)) FreeL((ADDRESS)id);
1065          v->rtyp = IDHDL;
1066          v->data = (char *)currRingHdl;
1067          v->name = IDID(currRingHdl);
1068          v->flag = IDFLAG(currRingHdl);
1069          return;
1070        }
1071        else
1072        {
1073          v->name = id;
1074          return; /* undefined */
1075        }
1076      }
1077      h=ggetid(id);
1078      /* 3) existing identifier, local */
1079      if ((h!=NULL) && (IDLEV(h)==myynest))
1080      {
1081        if (id!=IDID(h)) FreeL((ADDRESS)id);
1082        v->rtyp = IDHDL;
1083        v->data = (char *)h;
1084        v->flag = IDFLAG(h);
1085        v->name = IDID(h);
1086        v->attribute=IDATTR(h);
1087        return;
1088      }
1089    }
1090    /* 4. local ring: ringvar */
1091    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1092    {
1093      int vnr;
1094      if ((vnr=rIsRingVar(id))>=0)
1095      {
1096        poly p=pOne();
1097        pSetExp(p,vnr+1,1);
1098        pSetm(p);
1099        v->data = (void *)p;
1100        v->name = id;
1101        v->rtyp = POLY_CMD;
1102        return;
1103      }
1104    }
1105    /* 5. existing identifier, global */
1106    if (h!=NULL)
1107    {
1108      if (id!=IDID(h)) FreeL((ADDRESS)id);
1109      v->rtyp = IDHDL;
1110      v->data = (char *)h;
1111      v->flag = IDFLAG(h);
1112      v->name = IDID(h);
1113      v->attribute=IDATTR(h);
1114      return;
1115    }
1116    /* 6. local ring: number/poly */
1117    if ((currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1118    {
1119      BOOLEAN ok=FALSE;
1120      poly p = (!noringvars) ? pmInit(id,ok) : (poly)NULL;
1121      if (ok)
1122      {
1123        if (p==NULL)
1124        {
1125          v->data = (void *)nInit(0);
1126          v->rtyp = NUMBER_CMD;
1127          FreeL((ADDRESS)id);
1128        }
1129        else
1130        if (pIsConstant(p))
1131        {
1132          v->data = pGetCoeff(p);
1133          pGetCoeff(p)=NULL;
1134          pFree1(p);
1135          v->rtyp = NUMBER_CMD;
1136          v->name = id;
1137        }
1138        else
1139        {
1140          v->data = p;
1141          v->rtyp = POLY_CMD;
1142          v->name = id;
1143        }
1144        return;
1145      }
1146    }
1147    /* 7. non-local ring: number/poly */
1148    {
1149      BOOLEAN ok=FALSE;
1150      poly p = ((currRingHdl!=NULL)&&(!noringvars)&&(IDLEV(currRingHdl)!=myynest))
1151               /* ring required */  /* not in decl */    /* already in case 4/6 */
1152                     ? pmInit(id,ok) : (poly)NULL;
1153      if (ok)
1154      {
1155        if (p==NULL)
1156        {
1157          v->data = (void *)nInit(0);
1158          v->rtyp = NUMBER_CMD;
1159          FreeL((ADDRESS)id);
1160        }
1161        else
1162        if (pIsConstant(p))
1163        {
1164          v->data = pGetCoeff(p);
1165          pGetCoeff(p)=NULL;
1166          pFree1(p);
1167          v->rtyp = NUMBER_CMD;
1168          v->name = id;
1169        }
1170        else
1171        {
1172          v->data = p;
1173          v->rtyp = POLY_CMD;
1174          v->name = id;
1175        }
1176        return;
1177      }
1178    }
1179    /* 8. basering ? */
1180    if ((myynest>1)&&(currRingHdl!=NULL))
1181    {
1182      if (strcmp(id,IDID(currRingHdl))==0)
1183      {
1184        if (IDID(currRingHdl)!=id) FreeL((ADDRESS)id);
1185        v->rtyp=IDHDL;
1186        v->data=currRingHdl;
1187        v->name=IDID(currRingHdl);
1188        v->attribute=IDATTR(currRingHdl);
1189        return;
1190      }
1191    }
1192  }
1193#ifdef SIQ
1194  else
1195    v->rtyp=DEF_CMD;
1196#endif
1197  /* 9: _ */
1198  if (strcmp(id,"_")==0)
1199  {
1200    FreeL((ADDRESS)id);
1201    v->Copy(&sLastPrinted);
1202  }
1203  else
1204  {
1205    /* 10: everything else */
1206    /* v->rtyp = UNKNOWN;*/
1207    v->name = id;
1208  }
1209}
1210
1211int sleftv::Eval()
1212{
1213  BOOLEAN nok=FALSE;
1214  leftv nn=next;
1215  next=NULL;
1216  if(rtyp==IDHDL)
1217  {
1218    int t=Typ();
1219    if (t!=PROC_CMD)
1220    {
1221      void *d=CopyD(t);
1222      data=d;
1223      rtyp=t;
1224      name=NULL;
1225      e=NULL;
1226    }
1227  }
1228  else if (rtyp==COMMAND)
1229  {
1230    command d=(command)data;
1231    if(d->op==PROC_CMD) //assume d->argc==2
1232    {
1233      char *what=(char *)(d->arg1.Data());
1234      idhdl h=ggetid(what);
1235      if((h!=NULL)&&(IDTYP(h)==PROC_CMD))
1236      {
1237        nok=d->arg2.Eval();
1238        if(!nok)
1239        {
1240          leftv r=iiMake_proc(h,&d->arg2);
1241          if (r!=NULL)
1242            memcpy(this,r,sizeof(sleftv));
1243          else
1244            nok=TRUE;
1245        }
1246      }
1247      else nok=TRUE;
1248    }
1249    else if (d->op=='=') //assume d->argc==2
1250    {
1251      char *n=d->arg1.name;
1252      if (n!=NULL)
1253      {
1254        nok=d->arg2.Eval();
1255        if (!nok)
1256        {
1257          int save_typ=d->arg1.rtyp;
1258          mmTestLP(n);
1259          syMake(&d->arg1,n); //assume  type of arg1==DEF_CMD
1260          mmTestLP(d->arg1.name);
1261          if (d->arg1.rtyp==IDHDL)
1262          {
1263            n=mstrdup(IDID((idhdl)d->arg1.data));
1264            killhdl((idhdl)d->arg1.data);
1265            d->arg1.data=NULL;
1266            d->arg1.name=n;
1267          }
1268          //d->arg1.rtyp=DEF_CMD;
1269          sleftv t;
1270          if(save_typ!=PROC_CMD) save_typ=d->arg2.rtyp;
1271          if ((BEGIN_RING<d->arg2.rtyp)&&(d->arg2.rtyp<END_RING)
1272          /*&&(QRING_CMD!=d->arg2.rtyp)*/)
1273            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&currRing->idroot);
1274          else
1275            nok=iiDeclCommand(&t,&d->arg1,0,save_typ,&idroot);
1276          memcpy(&d->arg1,&t,sizeof(sleftv));
1277          mmTestLP(d->arg1.name);
1278          nok=nok||iiAssign(&d->arg1,&d->arg2);
1279          mmTestLP(d->arg1.name);
1280          if (!nok)
1281          {
1282            memset(&d->arg1,0,sizeof(sleftv));
1283            this->CleanUp();
1284            memset(this,0,sizeof(sleftv));
1285            rtyp=NONE;
1286          }
1287        }
1288      }
1289      else nok=TRUE;
1290    }
1291    else if (d->argc==1)
1292    {
1293      nok=d->arg1.Eval();
1294      nok=nok||iiExprArith1(this,&d->arg1,d->op);
1295    }
1296    else if(d->argc==2)
1297    {
1298      nok=d->arg1.Eval();
1299      nok=nok||d->arg2.Eval();
1300      nok=nok||iiExprArith2(this,&d->arg1,d->op,&d->arg2);
1301    }
1302    else if(d->argc==3)
1303    {
1304      nok=d->arg1.Eval();
1305      nok=nok||d->arg2.Eval();
1306      nok=nok||d->arg3.Eval();
1307      nok=nok||iiExprArith3(this,d->op,&d->arg1,&d->arg2,&d->arg3);
1308    }
1309    else if(d->argc!=0)
1310    {
1311      nok=d->arg1.Eval();
1312      nok=nok||iiExprArithM(this,&d->arg1,d->op);
1313    }
1314    else // d->argc == 0
1315    {
1316      nok = iiExprArithM(this, NULL, d->op);
1317    }
1318  }
1319  else if (((rtyp==0)||(rtyp==DEF_CMD))
1320    &&(name!=NULL))
1321  {
1322     syMake(this,name);
1323  }
1324#ifdef MDEBUG
1325  switch(Typ())
1326  {
1327    case NUMBER_CMD:
1328#ifdef LDEBUG
1329      nTest((number)Data());
1330#endif
1331      break;
1332    case POLY_CMD:
1333      pTest((poly)Data());
1334      break;
1335    case IDEAL_CMD:
1336    case MODUL_CMD:
1337    case MATRIX_CMD:
1338      {
1339        ideal id=(ideal)Data();
1340        mmTest(id,sizeof(*id));
1341        int i=id->ncols*id->nrows-1;
1342        for(;i>=0;i--) pTest(id->m[i]);
1343      }
1344      break;
1345  }
1346#endif
1347  if (nn!=NULL) nok=nok||nn->Eval();
1348  next=nn;
1349  return nok;
1350}
1351
Note: See TracBrowser for help on using the repository browser.