source: git/Singular/subexpr.cc @ 18dd47

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