source: git/Singular/ipassign.cc @ 4ad0d6

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