source: git/Singular/ipassign.cc @ fca547

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