source: git/Singular/ipassign.cc @ 36ff0ee

spielwiese
Last change on this file since 36ff0ee was e0bc8f0, checked in by Hans Schönemann <hannes@…>, 26 years ago
* hannes: fixed: Singular crashed while changing the minpoly in GF(q) (ipassign.cc) git-svn-id: file:///usr/local/Singular/svn/trunk@1231 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 31.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipassign.cc,v 1.24 1998-03-13 15:18:16 Singular Exp $ */
5
6/*
7* ABSTRACT: interpreter:
8*           assignment of expressions and lists to objects or lists
9*/
10
11#include <stdlib.h>
12#include <string.h>
13#include <ctype.h>
14
15#include "mod2.h"
16#include "tok.h"
17#include "ipid.h"
18#include "intvec.h"
19#include "mmemory.h"
20#include "febase.h"
21#include "polys.h"
22#include "ideals.h"
23#include "matpol.h"
24#include "kstd1.h"
25#include "timer.h"
26#include "ring.h"
27#include "subexpr.h"
28#include "numbers.h"
29#include "lists.h"
30#include "longalg.h"
31#include "stairc.h"
32#include "maps.h"
33#include "syz.h"
34#include "weight.h"
35#include "ipconv.h"
36#include "attrib.h"
37#include "silink.h"
38#include "ipshell.h"
39
40/*=================== proc =================*/
41#ifdef SRING
42static BOOLEAN jjALTVARS(leftv res, leftv a)
43{
44  pAltVars=(int)a->Data();
45  pSRING=(pAltVars<=pVariables);
46  pSDRING=pSDRING||pSRING;
47  currRing->partN=pAltVars;
48  return FALSE;
49}
50#endif
51static BOOLEAN jjECHO(leftv res, leftv a)
52{
53  si_echo=(int)a->Data();
54  return FALSE;
55}
56static BOOLEAN jjPAGELENGTH(leftv res, leftv a)
57{
58  pagelength=(int)a->Data();
59  return FALSE;
60}
61static BOOLEAN jjPRINTLEVEL(leftv res, leftv a)
62{
63  printlevel=(int)a->Data();
64  return FALSE;
65}
66static BOOLEAN jjCOLMAX(leftv res, leftv a)
67{
68  colmax=(int)a->Data();
69  return FALSE;
70}
71static BOOLEAN jjTIMER(leftv res, leftv a)
72{
73  timerv=(int)a->Data();
74  initTimer();
75  return FALSE;
76}
77#ifdef HAVE_RTIMER
78static BOOLEAN jjRTIMER(leftv res, leftv a)
79{
80  rtimerv=(int)a->Data();
81  initRTimer();
82  return FALSE;
83}
84#endif
85static BOOLEAN jjMAXDEG(leftv res, leftv a)
86{
87  Kstd1_deg=(int)a->Data();
88  if (Kstd1_deg!=0)
89    test |=Sy_bit(24);
90  else
91    test &=(~Sy_bit(24));
92  return FALSE;
93}
94static BOOLEAN jjMAXMULT(leftv res, leftv a)
95{
96  Kstd1_mu=(int)a->Data();
97  if (Kstd1_mu!=0)
98    test |=Sy_bit(23);
99  else
100    test &=(~Sy_bit(23));
101  return FALSE;
102}
103static BOOLEAN jjTRACE(leftv res, leftv a)
104{
105  traceit=(int)a->Data();
106  return FALSE;
107}
108static BOOLEAN jjSHORTOUT(leftv res, leftv a)
109{
110#ifdef HAVE_TCL
111  if (!tclmode)
112#endif
113    pShortOut=(int)a->Data();
114  return FALSE;
115}
116static BOOLEAN jjMINPOLY(leftv res, leftv a)
117{
118  if ((currRing->parameter!=NULL)
119  && ((currRing->P>1)
120    || (currRing->ch>1/* GF(q) <=> parameter!=NULL && ch=q>1*/)))
121  {
122    WerrorS("no minpoly allowed");
123    return TRUE;
124  }
125  if (currRing->minpoly!=NULL)
126  {
127    WerrorS("minpoly already set");
128    return TRUE;
129  }
130  number p=(number)a->CopyD(NUMBER_CMD);
131  if (!nIsZero(p))
132  {
133    nNormalize(p);
134    currRing->minpoly=p;
135    naMinimalPoly=((lnumber)currRing->minpoly)->z;
136  }
137  else
138  {
139    naMinimalPoly=NULL;
140  }
141  return FALSE;
142}
143static BOOLEAN jjNOETHER(leftv res, leftv a)
144{
145  poly p=(poly)a->CopyD(POLY_CMD);
146  pDelete(&ppNoether);
147  ppNoether=p;
148  return FALSE;
149}
150/*=================== proc =================*/
151static void jiAssignAttr(leftv l,leftv r)
152{
153  // get the attribute of th right side
154  // and set it to l
155  leftv rv=r->LData();
156  if (rv!=NULL)
157  {
158    if (rv->e==NULL)
159    {
160      if (rv->attribute!=NULL)
161      {
162        attr la;
163        if (r->rtyp!=IDHDL)
164        {
165          la=rv->attribute;
166          rv->attribute=NULL;
167        }
168        else
169        {
170          la=rv->attribute->Copy();
171        }
172        l->attribute=la;
173      }
174      l->flag=rv->flag;
175    }
176  }
177  if (l->rtyp==IDHDL)
178  {
179    idhdl h=(idhdl)l->data;
180    IDATTR(h)=l->attribute;
181    IDFLAG(h)=l->flag;
182  }
183}
184static BOOLEAN jiA_INT(leftv res, leftv a, Subexpr e)
185{
186  if (e==NULL)
187  {
188    res->data=(void *)a->Data();
189    jiAssignAttr(res,a);
190  }
191  else
192  {
193    int i=e->start-1;
194    if (i<0)
195    {
196      Werror("index[%d] must be positive",i+1);
197      return TRUE;
198    }
199    intvec *iv=(intvec *)res->data;
200    if (e->next==NULL)
201    {
202      if (i>=iv->length())
203      {
204        intvec *iv1=new intvec(i+1);
205        (*iv1)[i]=(int)a->Data();
206        intvec *ivn=ivAdd(iv,iv1);
207        delete iv;
208        delete iv1;
209        res->data=(void *)ivn;
210      }
211      else
212        (*iv)[i]=(int)a->Data();
213    }
214    else
215    {
216      int c=e->next->start;
217      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
218      {
219        Werror("wrong range [%d,%d] in intmat (%d,%d)",i+1,c,iv->rows(),iv->cols());
220        return TRUE;
221      }
222      else
223        IMATELEM(*iv,i+1,c) = (int)a->Data();
224    }
225  }
226  return FALSE;
227}
228static BOOLEAN jiA_NUMBER(leftv res, leftv a, Subexpr e)
229{
230  number p=(number)a->CopyD(NUMBER_CMD);
231  if (res->data!=NULL) nDelete((number *)&res->data);
232  nNormalize(p);
233  res->data=(void *)p;
234  jiAssignAttr(res,a);
235  return FALSE;
236}
237static BOOLEAN jiA_LIST(leftv res, leftv a,Subexpr e)
238{
239  lists l=(lists)a->CopyD();
240  if (res->data!=NULL) ((lists)res->data)->Clean();
241  res->data=(void *)l;
242  jiAssignAttr(res,a);
243  return FALSE;
244}
245static BOOLEAN jiA_POLY(leftv res, leftv a,Subexpr e)
246{
247  poly p=(poly)a->CopyD(POLY_CMD);
248  pNormalize(p);
249  if (e==NULL)
250  {
251    if (res->data!=NULL) pDelete((poly*)&res->data);
252    res->data=(void*)p;
253    jiAssignAttr(res,a);
254  }
255  else
256  {
257    int i,j;
258    matrix m=(matrix)res->data;
259    i=e->start;
260    if (e->next==NULL)
261    {
262      j=i; i=1;
263      // for ideal/module: check indices
264      if (res->rtyp!=MAP_CMD)
265      {
266        if (j>MATCOLS(m))
267        {
268          pEnlargeSet(&(m->m),MATCOLS(m),j-MATCOLS(m));
269          MATCOLS(m)=j;
270        }
271        else if (j<=0)
272        {
273          Werror("index[%d] must be positive",j/*e->start*/);
274          return TRUE;
275        }
276      }
277    }
278    else
279    {
280      // for matrices: indices are correct (see ipExprArith3(..,'['..) )
281      j=e->next->start;
282    }
283    pDelete(&MATELEM(m,i,j));
284    MATELEM(m,i,j)=p;
285    /* for module: update rank */
286    if ((p!=NULL) && (pGetComp(p)!=0))
287    {
288      m->rank=max(m->rank,pMaxComp(p));
289    }
290  }
291  return FALSE;
292}
293static BOOLEAN jiA_1x1MATRIX(leftv res, leftv a,Subexpr e)
294{
295  if ((res->rtyp!=MATRIX_CMD) /*|| (e!=NULL) - TRUE because of type poly */)
296     return TRUE;
297  matrix am=(matrix)a->CopyD(MATRIX_CMD);
298  if ((MATROWS(am)!=1) || (MATCOLS(am)!=1))
299  {
300    idDelete((ideal *)&am);
301    return TRUE;
302  }
303  matrix m=(matrix)res->data;
304  // indices are correct (see ipExprArith3(..,'['..) )
305  int i=e->start;
306  int j=e->next->start;
307  pDelete(&MATELEM(m,i,j));
308  pNormalize(MATELEM(am,1,1));
309  MATELEM(m,i,j)=MATELEM(am,1,1);
310  return FALSE;
311}
312static BOOLEAN jiA_STRING(leftv res, leftv a, Subexpr e)
313{
314  if (e==NULL)
315  {
316    FreeL((ADDRESS)res->data);
317    res->data=(void *)a->CopyD(STRING_CMD);
318    jiAssignAttr(res,a);
319  }
320  else
321  {
322    char *s=(char *)res->data;
323    if ((e->start>0)&&(e->start<=(int)strlen(s)))
324      s[e->start-1]=(char)(*((char *)a->Data()));
325    else
326    {
327      Werror("string index %d out of range 1..%d",e->start,strlen(s));
328      return TRUE;
329    }
330  }
331  return FALSE;
332}
333static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr e)
334{
335  extern procinfo *iiInitSingularProcinfo(procinfo *pi, char *libname,
336                                          char *procname, int line,
337                                          long pos, BOOLEAN pstatic=FALSE);
338  extern void piCleanUp(procinfov pi);
339
340  if(res->data!=NULL) piCleanUp((procinfo *)res->data);
341  if(a->rtyp==STRING_CMD) {
342    res->data = (void *)Alloc(sizeof(procinfo));
343    memset(res->data,0,sizeof(*(res->data)));
344    ((procinfo *)(res->data))->language=LANG_NONE;
345    iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
346    ((procinfo *)res->data)->data.s.body=(char *)a->CopyD(STRING_CMD);
347  }
348  else
349    res->data=(void *)a->CopyD(PROC_CMD);
350  jiAssignAttr(res,a);
351  return FALSE;
352}
353static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr e)
354{
355  if (res->data!=NULL) delete ((intvec *)res->data);
356  res->data=(void *)a->CopyD(INTVEC_CMD);
357  jiAssignAttr(res,a);
358  return FALSE;
359}
360static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr e)
361{
362  if (res->data!=NULL) idDelete((ideal*)&res->data);
363  res->data=(void *)a->CopyD(MATRIX_CMD);
364  jiAssignAttr(res,a);
365  return FALSE;
366}
367static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr e)
368{
369  if (res->data!=NULL) syKillComputation((syStrategy)res->data);
370  res->data=(void *)a->CopyD(RESOLUTION_CMD);
371  jiAssignAttr(res,a);
372  return FALSE;
373}
374static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr e)
375{
376  if (res->data!=NULL) idDelete((ideal*)&res->data);
377  ideal I=idInit(1,1);
378  I->m[0]=(poly)a->CopyD();
379  if (I->m[0]!=NULL) pSetComp(I->m[0],1);
380  res->data=(void *)I;
381  return FALSE;
382}
383static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr e)
384{
385  if (res->data!=NULL) idDelete((ideal*)&res->data);
386  matrix m=(matrix)a->CopyD(MATRIX_CMD);
387  IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m);
388  ((ideal)m)->rank=1;
389  MATROWS(m)=1;
390  res->data=(void *)m;
391  return FALSE;
392}
393static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr e)
394{
395  si_link l=(si_link)res->data;
396
397  if (l!=NULL) slCleanUp(l);
398
399  if (a->Typ() == STRING_CMD)
400  {
401    if (l == NULL)
402    {
403      l = (si_link) Alloc0(sizeof(sip_link));
404      res->data = (void *) l;
405    }
406    return slInit(l, (char *) a->Data());
407  }
408  else if (a->Typ() == LINK_CMD)
409  {
410    if (l != NULL) Free(l, sizeof(sip_link));
411    res->data = slCopy((si_link)a->Data());
412    return FALSE;
413  }
414  return TRUE;
415}
416static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr e)
417{
418  if (res->data!=NULL)
419  {
420    FreeL((ADDRESS)((map)res->data)->preimage);
421    ((map)res->data)->preimage=NULL;
422    idDelete((ideal*)&res->data);
423  }
424  res->data=(void *)a->CopyD();
425  jiAssignAttr(res,a);
426  return FALSE;
427}
428static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr e)
429{
430  map f=(map)res->data;
431  char *rn=f->preimage; // save the old/already assigned preimage ring name
432  f->preimage=NULL;
433  idDelete((ideal *)&f);
434  res->data=(void *)a->CopyD(IDEAL_CMD);
435  f=(map)res->data;
436  f->preimage = rn;
437  return FALSE;
438}
439static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
440{
441  // the follwing can only happen, if:
442  //   - the left side is of type qring AND not an id
443  if ((e!=NULL)||(res->rtyp!=IDHDL))
444  {
445    WerrorS("qring_id expected");
446    return TRUE;
447  }
448  ring qr;
449  int i,j;
450  int *pi;
451
452  assumeStdFlag(a);
453  qr=(ring)res->Data();
454  ring qrr=rCopy(currRing);
455  // hier fehlt noch: evtl. vorhandenen alten Ring streichen
456  // vorerst nur:
457  memcpy4(qr,qrr,sizeof(ip_sring));
458  Free(qrr,sizeof(ip_sring));
459  if (qr->qideal!=NULL) idDelete(&qr->qideal);
460  qr->qideal = (ideal)a->CopyD(IDEAL_CMD);
461  currRing=qr;
462  currRingHdl=(idhdl)res->data;
463  currQuotient=qr->qideal;
464  return FALSE;
465}
466static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e)
467{
468  if ((e!=NULL)||(res->rtyp!=IDHDL))
469  {
470    WerrorS("id expected");
471    return TRUE;
472  }
473  ring r=(ring)a->Data();
474  idhdl rl=(idhdl)res->data;
475  if (&IDRING(rl)!=NULL) rKill(rl);
476  r->ref++;
477  IDRING(rl)=r;
478  if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing))
479    currRingHdl=(idhdl)res->data;
480  return FALSE;
481}
482/*=================== table =================*/
483struct sValAssign dAssign[]=
484{
485// proc         res             arg
486 {jiA_IDEAL,    IDEAL_CMD,      IDEAL_CMD }
487,{jiA_IDEAL_M,  IDEAL_CMD,      MATRIX_CMD }
488,{jiA_RESOLUTION,RESOLUTION_CMD,RESOLUTION_CMD }
489,{jiA_INT,      INT_CMD,        INT_CMD }
490,{jiA_IDEAL,    MATRIX_CMD,     MATRIX_CMD }
491,{jiA_MAP_ID,   MAP_CMD,        IDEAL_CMD }
492,{jiA_MAP,      MAP_CMD,        MAP_CMD }
493,{jiA_IDEAL,    MODUL_CMD,      MODUL_CMD }
494,{jiA_MODUL_P,  MODUL_CMD,      POLY_CMD }
495,{jiA_POLY,     POLY_CMD,       POLY_CMD }
496,{jiA_1x1MATRIX,POLY_CMD,       MATRIX_CMD }
497,{jiA_QRING,    QRING_CMD,      IDEAL_CMD }
498,{jiA_RING,     RING_CMD,       RING_CMD }
499,{jiA_RING,     QRING_CMD,      QRING_CMD }
500,{jiA_STRING,   STRING_CMD,     STRING_CMD }
501,{jiA_PROC,     PROC_CMD,       STRING_CMD }
502,{jiA_PROC,     PROC_CMD,       PROC_CMD }
503,{jiA_POLY,     VECTOR_CMD,     VECTOR_CMD }
504,{jiA_INTVEC,   INTVEC_CMD,     INTVEC_CMD }
505,{jiA_INTVEC,   INTMAT_CMD,     INTMAT_CMD }
506,{jiA_NUMBER,   NUMBER_CMD,     NUMBER_CMD }
507,{jiA_LIST,     LIST_CMD,       LIST_CMD }
508,{jiA_LINK,     LINK_CMD,       STRING_CMD }
509,{jiA_LINK,     LINK_CMD,       LINK_CMD }
510,{NULL,         0,              0 }
511};
512struct sValAssign_sys dAssign_sys[]=
513{
514// sysvars:
515 {jjECHO,       VECHO,          INT_CMD }
516#ifdef SRING
517,{jjALTVARS,    VALTVARS,       INT_CMD }
518#endif
519,{jjPAGELENGTH, VPAGELENGTH,    INT_CMD }
520,{jjPRINTLEVEL, VPRINTLEVEL,    INT_CMD }
521,{jjCOLMAX,     VCOLMAX,        INT_CMD }
522,{jjTIMER,      VTIMER,         INT_CMD }
523#ifdef HAVE_RTIMER
524,{jjRTIMER,     VRTIMER,        INT_CMD }
525#endif
526,{jjMAXDEG,     VMAXDEG,        INT_CMD }
527,{jjMAXMULT,    VMAXMULT,       INT_CMD }
528,{jjTRACE,      TRACE,          INT_CMD }
529,{jjSHORTOUT,   VSHORTOUT,      INT_CMD }
530,{jjMINPOLY,    VMINPOLY,       NUMBER_CMD }
531,{jjNOETHER,    VNOETHER,       POLY_CMD }
532,{NULL,         0,              0 }
533};
534/*=================== operations ============================*/
535/*2
536* assign a = b
537*/
538static BOOLEAN jiAssign_1(leftv l, leftv r)
539{
540  int rt=r->Typ();
541  if (rt==0)
542  {
543    if (!errorreported) Werror("`%s` is undefined",r->Name());
544    return TRUE;
545  }
546
547  int lt=l->Typ();
548  if((lt==0)/*&&(l->name!=NULL)*/)
549  {
550    if (!errorreported) Werror("left side `%s` is undefined",l->Name());
551    return TRUE;
552  }
553  if((rt==DEF_CMD)||(rt==NONE))
554  {
555    if (!errorreported) WerrorS("right side is not a datum");
556    return TRUE;
557  }
558
559  int i=0;
560  BOOLEAN nok=FALSE;
561
562  if (lt==DEF_CMD)
563  {
564    if (l->rtyp==IDHDL)
565    {
566      IDTYP((idhdl)l->data)=rt;
567    }
568    else if (l->name!=NULL)
569    {
570      sleftv ll;
571      iiDeclCommand(&ll,l,myynest,rt,&idroot);
572      memcpy(l,&ll,sizeof(sleftv));
573    }
574    else
575    {
576      l->rtyp=rt;
577    }
578    lt=rt;
579  }
580  else
581  {
582    if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
583      return FALSE;
584  }
585  leftv ld=l;
586  if ((l->rtyp==IDHDL)&&(lt!=QRING_CMD)&&(lt!=RING_CMD))
587    ld=(leftv)l->data;
588  while (((dAssign[i].res!=lt)
589      || (dAssign[i].arg!=rt))
590    && (dAssign[i].res!=0)) i++;
591  if (dAssign[i].res!=0)
592  {
593    BOOLEAN b;
594    b=dAssign[i].p(ld,r,l->e);
595    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
596    {
597      l->flag=ld->flag;
598      l->attribute=ld->attribute;
599    }
600    return b;
601  }
602  // implicite type conversion ----------------------------------------------
603  if (dAssign[i].res==0)
604  {
605    int ri;
606    leftv rn = (leftv)Alloc0(sizeof(sleftv));
607    BOOLEAN failed=FALSE;
608    i=0;
609    while ((dAssign[i].res!=lt)
610      && (dAssign[i].res!=0)) i++;
611    while (dAssign[i].res==lt)
612    {
613      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
614      {
615        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
616        if(!failed)
617        {
618          failed= dAssign[i].p(ld,rn,l->e);
619        }
620        // everything done, clean up temp. variables
621        rn->CleanUp();
622        Free((ADDRESS)rn,sizeof(sleftv));
623        if (failed)
624        {
625          // leave loop, goto error handling
626          break;
627        }
628        else
629        {
630          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
631          {
632            l->flag=ld->flag;
633            l->attribute=ld->attribute;
634          }
635          // everything ok, return
636          return FALSE;
637        }
638     }
639     i++;
640    }
641    // error handling ---------------------------------------------------
642    if (!errorreported)
643    {
644      Werror("`%s` = `%s` is not supported"
645             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
646      if (BVERBOSE(V_SHOW_USE))
647      {
648        i=0;
649        while ((dAssign[i].res!=lt)
650          && (dAssign[i].res!=0)) i++;
651        while (dAssign[i].res==lt)
652        {
653          Werror("expected `%s` = `%s`"
654              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
655          i++;
656        }
657      }
658    }
659  }
660  return TRUE;
661}
662/*2
663* assign sys_var = val
664*/
665static BOOLEAN iiAssign_sys(leftv l, leftv r)
666{
667  int rt=r->Typ();
668
669  if (rt==0)
670  {
671    if (!errorreported) Werror("`%s` is undefined",r->Name());
672    return TRUE;
673  }
674  int i=0;
675  int lt=l->rtyp;
676  while (((dAssign_sys[i].res!=lt)
677      || (dAssign_sys[i].arg!=rt))
678    && (dAssign_sys[i].res!=0)) i++;
679  if (dAssign_sys[i].res!=0)
680  {
681    if (!dAssign_sys[i].p(l,r))
682    {
683      // everything ok, clean up
684      return FALSE;
685    }
686  }
687  // implicite type conversion ----------------------------------------------
688  if (dAssign_sys[i].res==0)
689  {
690    int ri;
691    leftv rn = (leftv)Alloc0(sizeof(sleftv));
692    BOOLEAN failed=FALSE;
693    i=0;
694    while ((dAssign_sys[i].res!=lt)
695      && (dAssign_sys[i].res!=0)) i++;
696    while (dAssign_sys[i].res==lt)
697    {
698      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
699      {
700        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
701            || (dAssign_sys[i].p(l,rn)));
702        // everything done, clean up temp. variables
703        rn->CleanUp();
704        Free((ADDRESS)rn,sizeof(sleftv));
705        if (failed)
706        {
707          // leave loop, goto error handling
708          break;
709        }
710        else
711        {
712          // everything ok, return
713          return FALSE;
714        }
715     }
716     i++;
717    }
718    // error handling ---------------------------------------------------
719    if(!errorreported)
720    {
721      Werror("`%s` = `%s` is not supported"
722             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
723      if (BVERBOSE(V_SHOW_USE))
724      {
725        i=0;
726        while ((dAssign_sys[i].res!=lt)
727          && (dAssign_sys[i].res!=0)) i++;
728        while (dAssign_sys[i].res==lt)
729        {
730          Werror("expected `%s` = `%s`"
731              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
732          i++;
733        }
734      }
735    }
736  }
737  return TRUE;
738}
739static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
740{
741  /* right side is intvec, left side is list (of int)*/
742  BOOLEAN nok;
743  int i=0;
744  leftv l1=l;
745  leftv h;
746  sleftv t;
747  intvec *iv=(intvec *)r->Data();
748  memset(&t,0,sizeof(sleftv));
749  t.rtyp=INT_CMD;
750  while ((i<iv->length())&&(l!=NULL))
751  {
752    t.data=(char *)(*iv)[i];
753    h=l->next;
754    l->next=NULL;
755    nok=jiAssign_1(l,&t);
756    if (nok) return TRUE;
757    i++;
758    l=h;
759  }
760  l1->CleanUp();
761  r->CleanUp();
762  return FALSE;
763}
764static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
765{
766  /* right side is vector, left side is list (of poly)*/
767  BOOLEAN nok;
768  leftv l1=l;
769  ideal I=idVec2Ideal((poly)r->Data());
770  leftv h;
771  sleftv t;
772  int i=0;
773  while (l!=NULL)
774  {
775    memset(&t,0,sizeof(sleftv));
776    t.rtyp=POLY_CMD;
777    if (i>=IDELEMS(I))
778    {
779      t.data=NULL;
780    }
781    else
782    {
783      t.data=(char *)I->m[i];
784      I->m[i]=NULL;
785    }
786    h=l->next;
787    l->next=NULL;
788    nok=jiAssign_1(l,&t);
789    t.CleanUp();
790    if (nok)
791    {
792      idDelete(&I);
793      return TRUE;
794    }
795    i++;
796    l=h;
797  }
798  idDelete(&I);
799  l1->CleanUp();
800  r->CleanUp();
801  return FALSE;
802}
803static BOOLEAN jjA_L_LIST(leftv l, leftv r)
804/* left side: list
805*  right side: expression list
806*/
807{
808  int sl = r->listLength();
809  lists L=(lists)Alloc(sizeof(slists));
810  leftv h=NULL,o_r=r;
811  int i;
812  int rt;
813
814  L->Init(sl);
815  for (i=0;i<sl;i++)
816  {
817    if (h!=NULL) { /* e.g. not in the first step:
818                   * h is the pointer to the old sleftv,
819                   * r is the pointer to the next sleftv
820                   * (in this moment) */
821                   h->next=r;
822                 }
823    h=r;
824    r=r->next;
825    h->next=NULL;
826    rt=h->Typ();
827    if ((rt==0)||(rt==NONE))
828    {
829      L->Clean();
830      Werror("`%s` is undefined",h->Name());
831      return TRUE;
832    }
833    //if ((rt==RING_CMD)||(rt==QRING_CMD))
834    //{
835    //  L->m[i].rtyp=rt;
836    //  L->m[i].data=h->Data();
837    //  ((ring)L->m[i].data)->ref++;
838    //}
839    //else
840      L->m[i].Copy(h);
841  }
842  IDLIST((idhdl)l->data)->Clean();
843  IDLIST((idhdl)l->data)=L;
844  ipMoveId((idhdl)l->data);
845  o_r->CleanUp();
846  return FALSE;
847}
848static BOOLEAN jiA_L_LIST(leftv l, leftv r)
849/* left side: list
850*  right side: expression list
851*/
852{
853  int sl = r->listLength();
854  lists L=(lists)Alloc(sizeof(slists));
855  leftv h=NULL;
856  int i;
857  int rt;
858
859  L->Init(sl);
860  for (i=0;i<sl;i++)
861  {
862    if (h!=NULL) { /* e.g. not in the first step:
863                   * h is the pointer to the old sleftv,
864                   * r is the pointer to the next sleftv
865                   * (in this moment) */
866                   h->next=r;
867                 }
868    h=r;
869    r=r->next;
870    h->next=NULL;
871    rt=h->Typ();
872    if (rt==0)
873    {
874      L->Clean();
875      Werror("`%s` is undefined",h->Name());
876      return TRUE;
877    }
878    if ((rt==RING_CMD)||(rt==QRING_CMD))
879    {
880      L->m[i].rtyp=rt;
881      L->m[i].data=h->Data();
882      ((ring)L->m[i].data)->ref++;
883    }
884    else
885      L->m[i].Copy(h);
886  }
887  IDLIST((idhdl)l->data)->Clean();
888  IDLIST((idhdl)l->data)=L;
889  return FALSE;
890}
891static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
892{
893  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
894  leftv hh=r;
895  int i = 0;
896  while (hh!=NULL)
897  {
898    if (i>=iv->length()) break;
899    if (hh->Typ() == INT_CMD)
900    {
901      (*iv)[i++] = (int)(hh->Data());
902    }
903    else if ((hh->Typ() == INTVEC_CMD)
904            ||(hh->Typ() == INTMAT_CMD))
905    {
906      intvec *ivv = (intvec *)(hh->Data());
907      int ll = 0,l = min(ivv->length(),iv->length());
908      for (; l>0; l--)
909      {
910        (*iv)[i++] = (*ivv)[ll++];
911      }
912    }
913    else
914    {
915      delete iv;
916      return TRUE;
917    }
918    hh = hh->next;
919  }
920  if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
921  IDINTVEC((idhdl)l->data)=iv;
922  return FALSE;
923}
924static BOOLEAN jjA_L_STRING(leftv l,leftv r)
925{
926  /* left side is string, right side is list of string*/
927  leftv hh=r;
928  int sl = 1;
929  char *s;
930  char *t;
931  int tl;
932  /* find the length */
933  while (hh!=NULL)
934  {
935    if (hh->Typ()!= STRING_CMD)
936    {
937      return TRUE;
938    }
939    sl += strlen((char *)hh->Data());
940    hh = hh->next;
941  }
942  s = (char * )AllocL(sl);
943  sl=0;
944  hh = r;
945  while (hh!=NULL)
946  {
947    t=(char *)hh->Data();
948    tl=strlen(t);
949    memcpy(s+sl,t,tl);
950    sl+=tl;
951    hh = hh->next;
952  }
953  s[sl]='\0';
954  FreeL((ADDRESS)IDDATA((idhdl)(l->data)));
955  IDDATA((idhdl)(l->data))=s;
956  return FALSE;
957}
958static BOOLEAN jjA_LIST_L(leftv l,leftv r)
959{
960  /*left side are something, right side are lists*/
961  /*e.g. a,b,c=l */
962  //int ll=l->listLength();
963  if (l->listLength()==1) return jiAssign_1(l,r);
964  BOOLEAN nok;
965  sleftv t;
966  leftv h;
967  lists L=(lists)r->Data();
968  int rl=L->nr;
969  int i=0;
970
971  memset(&t,0,sizeof(sleftv));
972  while ((i<=rl)&&(l!=NULL))
973  {
974    memset(&t,0,sizeof(sleftv));
975    t.Copy(&L->m[i]);
976    h=l->next;
977    l->next=NULL;
978    nok=jiAssign_1(l,&t);
979    if (nok) return TRUE;
980    i++;
981    l=h;
982  }
983  r->CleanUp();
984  return FALSE;
985}
986static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
987{
988  /* right side is matrix, left side is list (of poly)*/
989  BOOLEAN nok=FALSE;
990  int i;
991  matrix m=(matrix)r->CopyD(MATRIX_CMD);
992  leftv h;
993  leftv ol=l;
994  leftv o_r=r;
995  sleftv t;
996  memset(&t,0,sizeof(sleftv));
997  t.rtyp=POLY_CMD;
998  loop
999  {
1000    i=0;
1001    while ((i<MATROWS(m)*MATCOLS(m))&&(l!=NULL))
1002    {
1003      t.data=(char *)m->m[i];
1004      m->m[i]=NULL;
1005      h=l->next;
1006      l->next=NULL;
1007      nok=jiAssign_1(l,&t);
1008      l->next=h;
1009      if (nok)
1010      {
1011        idDelete((ideal *)&m);
1012        goto ende;
1013      }
1014      i++;
1015      l=h;
1016    }
1017    idDelete((ideal *)&m);
1018    h=r;
1019    r=r->next;
1020    if (l==NULL)
1021    {
1022      if (r!=NULL)
1023      {
1024        Warn("list length mismatch in assign (l>r)");
1025        nok=TRUE;
1026      }
1027      break;
1028    }
1029    else if (r==NULL)
1030    {
1031      Warn("list length mismatch in assign (l<r)");
1032      nok=TRUE;
1033      break;
1034    }
1035    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1036      m=(matrix)r->CopyD(MATRIX_CMD);
1037    else if (r->Typ()==POLY_CMD)
1038    {
1039      m=mpNew(1,1);
1040      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1041    }
1042    else
1043    {
1044      nok=TRUE;
1045      break;
1046    }
1047  }
1048ende:
1049  o_r->CleanUp();
1050  ol->CleanUp();
1051  return nok;
1052}
1053static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1054{
1055  /*left side are strings, right side is a string*/
1056  /*e.g. s[2..3]="12" */
1057  /*the case s=t[1..4] is handled in iiAssign,
1058  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1059  int ll=l->listLength();
1060  int rl=r->listLength();
1061  BOOLEAN nok=FALSE;
1062  sleftv t;
1063  leftv h,l1=l;
1064  int i=0;
1065  char *ss;
1066  char *s=(char *)r->Data();
1067  int sl=strlen(s);
1068
1069  memset(&t,0,sizeof(sleftv));
1070  t.rtyp=STRING_CMD;
1071  while ((i<sl)&&(l!=NULL))
1072  {
1073    ss=(char *)AllocL(2);
1074    ss[1]='\0';
1075    ss[0]=s[i];
1076    t.data=ss;
1077    h=l->next;
1078    l->next=NULL;
1079    nok=jiAssign_1(l,&t);
1080    if (nok)
1081    {
1082      break;
1083    }
1084    i++;
1085    l=h;
1086  }
1087  r->CleanUp();
1088  l1->CleanUp();
1089  return nok;
1090}
1091static BOOLEAN jiAssign_list(leftv l, leftv r)
1092{
1093  int i=l->e->start-1;
1094  if (i<0)
1095  {
1096    Werror("index[%d] must be positive",i+1);
1097    return TRUE;
1098  }
1099  if(l->attribute!=NULL)
1100  {
1101    atKillAll((idhdl)l);
1102    l->attribute=NULL;
1103  }
1104  l->flag=0;
1105  lists li;
1106  if (l->rtyp==IDHDL)
1107  {
1108    li=IDLIST((idhdl)l->data);
1109  }
1110  else
1111  {
1112    li=(lists)l->data;
1113  }
1114  if (i>li->nr)
1115  {
1116    li->m=(leftv)ReAlloc(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1117    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1118    int j=li->nr+1;
1119    for(;j<=i;j++)
1120      li->m[j].rtyp=DEF_CMD;
1121    li->nr=i;
1122  }
1123  leftv ld=&(li->m[i]);
1124  ld->e=l->e->next;
1125  BOOLEAN b;
1126  if ((ld->rtyp!=LIST_CMD)
1127  &&(ld->e==NULL)
1128  &&(ld->Typ()!=r->Typ()))
1129  {
1130    sleftv tmp;
1131    memset(&tmp,0,sizeof(sleftv));
1132    tmp.rtyp=DEF_CMD;
1133    b=iiAssign(&tmp,r);
1134    ld->CleanUp();
1135    memcpy(ld,&tmp,sizeof(sleftv));
1136  }
1137  else
1138  {
1139    b=iiAssign(ld,r);
1140    l->e->next=ld->e;
1141  }
1142  return b;
1143}
1144static BOOLEAN jiAssign_rec(leftv l, leftv r)
1145{
1146  leftv l1=l;
1147  leftv r1=r;
1148  leftv lrest;
1149  leftv rrest;
1150  BOOLEAN b;
1151  do
1152  {
1153    lrest=l->next;
1154    rrest=r->next;
1155    l->next=NULL;
1156    r->next=NULL;
1157    b=iiAssign(l,r);
1158    l->next=lrest;
1159    r->next=rrest;
1160    l=lrest;
1161    r=rrest;
1162  } while  ((!b)&&(l!=NULL));
1163  l1->CleanUp();
1164  r1->CleanUp();
1165  return b;
1166}
1167BOOLEAN iiAssign(leftv l, leftv r)
1168{
1169  int ll=l->listLength();
1170  int rl;
1171  int lt=l->Typ();
1172  int rt=NONE;
1173  BOOLEAN b;
1174
1175  if(l->attribute!=NULL)
1176  {
1177    if (l->rtyp==IDHDL)
1178    {
1179      atKillAll((idhdl)l->data);
1180      l->attribute=NULL;
1181    }
1182    else
1183      atKillAll((idhdl)l);
1184  }
1185  if(l->rtyp==IDHDL)
1186  {
1187    IDFLAG((idhdl)l->data)=0;
1188  }
1189  l->flag=0;
1190  if (ll==1)
1191  {
1192    /* l[..] = ... */
1193    if((l->e!=NULL)
1194    && (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1195      || (l->rtyp==LIST_CMD)))
1196    {
1197       if(r->next!=NULL)
1198         b=jiA_L_LIST(l,r);
1199       else
1200         b=jiAssign_list(l,r);
1201       if((l->rtyp==IDHDL) && (l->data!=NULL))
1202       {
1203         ipMoveId((idhdl)l->data);
1204         l->attribute=IDATTR((idhdl)l->data);
1205         l->flag=IDFLAG((idhdl)l->data);
1206       }
1207       r->CleanUp();
1208       Subexpr h;
1209       while (l->e!=NULL)
1210       {
1211         h=l->e->next;
1212         Free((ADDRESS)l->e,sizeof(*(l->e)));
1213         l->e=h;
1214       }
1215       return b;
1216    }
1217    rl=r->listLength();
1218    if (rl==1)
1219    {
1220      /* system variables = ... */
1221      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1222      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1223      {
1224         b=iiAssign_sys(l,r);
1225         r->CleanUp();
1226         //l->CleanUp();
1227         return b;
1228      }
1229      rt=r->Typ();
1230      /* a = ... */
1231      if ((lt!=MATRIX_CMD)
1232      &&(lt!=INTMAT_CMD)
1233      &&((lt==rt)||(lt!=LIST_CMD)))
1234      {
1235         b=jiAssign_1(l,r);
1236         if (l->rtyp==IDHDL)
1237         {
1238           if ((lt==DEF_CMD)||(lt=LIST_CMD)) ipMoveId((idhdl)l->data);
1239           l->attribute=IDATTR((idhdl)l->data);
1240           l->flag=IDFLAG((idhdl)l->data);
1241           l->CleanUp();
1242         }
1243         r->CleanUp();
1244         return b;
1245      }
1246      if ((lt!=LIST_CMD)
1247      &&((rt==MATRIX_CMD)
1248        ||(rt==INTMAT_CMD)
1249        ||(rt==INTVEC_CMD)
1250        ||(rt==MODUL_CMD)))
1251      {
1252         b=jiAssign_1(l,r);
1253         if((l->rtyp==IDHDL)&&(l->data!=NULL))
1254         {
1255           if (lt==DEF_CMD) ipMoveId((idhdl)l->data);
1256           l->attribute=IDATTR((idhdl)l->data);
1257           l->flag=IDFLAG((idhdl)l->data);
1258         }
1259         r->CleanUp();
1260         Subexpr h;
1261         while (l->e!=NULL)
1262         {
1263           h=l->e->next;
1264           Free((ADDRESS)l->e,sizeof(*(l->e)));
1265           l->e=h;
1266         }
1267         return b;
1268      }
1269    }
1270    if (rt==NONE) rt=r->Typ();
1271  }
1272  else if (ll==(rl=r->listLength()))
1273  {
1274    b=jiAssign_rec(l,r);
1275    return b;
1276  }
1277  else
1278  {
1279    if (rt==NONE) rt=r->Typ();
1280    if (rt==INTVEC_CMD)
1281      return jiA_INTVEC_L(l,r);
1282    else if (rt==VECTOR_CMD)
1283      return jiA_VECTOR_L(l,r);
1284    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1285      return jiA_MATRIX_L(l,r);
1286    else if ((rt==STRING_CMD)&&(rl==1))
1287      return jiA_STRING_L(l,r);
1288    Werror("length of lists in assignment does not match (l:%d,r:%d)",
1289      ll,rl);
1290    return TRUE;
1291  }
1292
1293  leftv hh=r;
1294  BOOLEAN nok=FALSE;
1295  BOOLEAN map_assign=FALSE;
1296  switch (lt)
1297  {
1298    case INTVEC_CMD:
1299      nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
1300      break;
1301    case INTMAT_CMD:
1302    {
1303      nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
1304      break;
1305    }
1306    case MAP_CMD:
1307    {
1308      // first element in the list sl (r) must be a ring
1309      if (((rt == RING_CMD)||(rt == QRING_CMD))&&(r->e==NULL))
1310      {
1311        FreeL((ADDRESS)IDMAP((idhdl)l->data)->preimage);
1312        IDMAP((idhdl)l->data)->preimage = mstrdup (r->Name());
1313        /* advance the expressionlist to get the next element after the ring */
1314        hh = r->next;
1315        //r=hh;
1316      }
1317      else
1318      {
1319        WerrorS("expected ring-name");
1320        nok=TRUE;
1321        break;
1322      }
1323      if (hh==NULL) /* map-assign: map f=r; */
1324      {
1325        WerrorS("expected image ideal");
1326        nok=TRUE;
1327        break;
1328      }
1329      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
1330        return jiAssign_1(l,hh); /* map-assign: map f=r,i; */
1331      //no break, handle the rest like an ideal:
1332      map_assign=TRUE;
1333    }
1334    case MATRIX_CMD:
1335    case IDEAL_CMD:
1336    case MODUL_CMD:
1337    {
1338      sleftv t;
1339      matrix olm = (matrix)l->Data();
1340      int rk=olm->rank;
1341      char *pr=((map)olm)->preimage;
1342      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
1343      matrix lm ;
1344      matrix rm;
1345      int  num;
1346      int j,k;
1347      int i=0;
1348      int mtyp=MATRIX_CMD; /*Type of left side object*/
1349      int etyp=POLY_CMD;   /*Type of elements of left side object*/
1350
1351      if (lt /*l->Typ()*/==MATRIX_CMD)
1352      {
1353        num=olm->cols()*olm->rows();
1354        lm=mpNew(olm->rows(),olm->cols());
1355      }
1356      else /* IDEAL_CMD or MODUL_CMD */
1357      {
1358        num=exprlist_length(hh);
1359        lm=(matrix)idInit(num,1);
1360        rk=1;
1361        if (module_assign)
1362        {
1363          mtyp=MODUL_CMD;
1364          etyp=VECTOR_CMD;
1365        }
1366      }
1367
1368      int ht;
1369      loop
1370      {
1371        if (hh==NULL)
1372          break;
1373        else
1374        {
1375          ht=hh->Typ();
1376          if ((j=iiTestConvert(ht,etyp))!=0)
1377          {
1378            nok=iiConvert(ht,etyp,j,hh,&t);
1379            hh->next=t.next;
1380            if (nok) break;
1381            lm->m[i]=(poly)t.CopyD(etyp);
1382            if (module_assign) rk=max(rk,pMaxComp(lm->m[i]));
1383            i++;
1384          }
1385          else
1386          if ((j=iiTestConvert(ht,mtyp))!=0)
1387          {
1388            nok=iiConvert(ht,mtyp,j,hh,&t);
1389            hh->next=t.next;
1390            if (nok) break;
1391            rm = (matrix)t.CopyD(mtyp);
1392            if (module_assign)
1393            {
1394              j = min(num,rm->cols());
1395              rk=max(rk,rm->rank);
1396            }
1397            else
1398              j = min(num-i,rm->rows() * rm->cols());
1399            for(k=0;k<j;k++,i++)
1400            {
1401              lm->m[i]=rm->m[k];
1402              rm->m[k]=NULL;
1403            }
1404            idDelete((ideal *)&rm);
1405          }
1406          else
1407          {
1408            nok=TRUE;
1409            break;
1410          }
1411          t.next=NULL;t.CleanUp();
1412          if (i==num) break;
1413          hh=hh->next;
1414        }
1415      }
1416      if (nok)
1417        idDelete((ideal *)&lm);
1418      else
1419      {
1420        idDelete((ideal *)&olm);
1421        if (module_assign)   lm->rank=rk;
1422        else if (map_assign) ((map)lm)->preimage=pr;
1423#ifdef DRING
1424        else if (pDRING)
1425        {
1426          int i=IDELEMS(lm)-1;
1427          while (i>=0)
1428          {
1429            pdSetDFlag(lm->m[i],1);
1430            i--;
1431          }
1432        }
1433#endif
1434        l=l->LData();
1435        if (l->rtyp==IDHDL)
1436          IDMATRIX((idhdl)l->data)=lm;
1437        else
1438          l->data=(char *)lm;
1439      }
1440      break;
1441    }
1442    case STRING_CMD:
1443      nok=jjA_L_STRING(l,r);
1444      break;
1445    case LIST_CMD:
1446      nok=jjA_L_LIST(l,r);
1447      break;
1448    case NONE:
1449    case 0:
1450      Werror("cannot assign to %s",l->Name());
1451      nok=TRUE;
1452      break;
1453    default:
1454      WerrorS("assign not impl.");
1455      nok=TRUE;
1456      break;
1457  } /* end switch: typ */
1458  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
1459  r->CleanUp();
1460  return nok;
1461}
Note: See TracBrowser for help on using the repository browser.