source: git/Singular/subexpr.cc @ 8d1d137

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