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

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