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

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