source: git/Singular/ipassign.cc @ 6a6dccc

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