source: git/Singular/ipassign.cc @ d336d53

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