source: git/Singular/subexpr.cc @ 7a7652

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