source: git/Singular/ipassign.cc @ 8357e21

spielwiese
Last change on this file since 8357e21 was 8357e21, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix: #433, type change in newstruct assignments
  • Property mode set to 100644
File size: 42.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: interpreter:
6*           assignment of expressions and lists to objects or lists
7*/
8
9#include <stdlib.h>
10#include <string.h>
11#include <ctype.h>
12
13#define TRANSEXT_PRIVATES
14
15#include <polys/ext_fields/transext.h>
16
17#include "config.h"
18#include <kernel/mod2.h>
19#include <omalloc/omalloc.h>
20
21#include <misc/options.h>
22#include <misc/intvec.h>
23
24#include <coeffs/coeffs.h>
25#include <coeffs/numbers.h>
26#include <coeffs/longrat.h>
27#include <coeffs/bigintmat.h>
28
29
30#include <polys/ext_fields/algext.h>
31
32#include <polys/monomials/ring.h>
33#include <polys/matpol.h>
34#include <polys/monomials/maps.h>
35#include <polys/nc/nc.h>
36#include <polys/nc/sca.h>
37
38#include <kernel/febase.h>
39#include <kernel/polys.h>
40#include <kernel/ideals.h>
41#include <kernel/kstd1.h>
42#include <kernel/timer.h>
43#include <kernel/stairc.h>
44#include <kernel/syz.h>
45
46//#include "weight.h"
47#include "tok.h"
48#include "ipid.h"
49#include "idrec.h"
50#include "subexpr.h"
51#include "lists.h"
52#include "ipconv.h"
53#include "attrib.h"
54#include "silink.h"
55#include "ipshell.h"
56#include "blackbox.h"
57
58
59
60/*=================== proc =================*/
61static BOOLEAN jjECHO(leftv, leftv a)
62{
63  si_echo=(int)((long)(a->Data()));
64  return FALSE;
65}
66static BOOLEAN jjPRINTLEVEL(leftv, leftv a)
67{
68  printlevel=(int)((long)(a->Data()));
69  return FALSE;
70}
71static BOOLEAN jjCOLMAX(leftv, leftv a)
72{
73  colmax=(int)((long)(a->Data()));
74  return FALSE;
75}
76static BOOLEAN jjTIMER(leftv, leftv a)
77{
78  timerv=(int)((long)(a->Data()));
79  initTimer();
80  return FALSE;
81}
82#ifdef HAVE_GETTIMEOFDAY
83static BOOLEAN jjRTIMER(leftv, leftv a)
84{
85  rtimerv=(int)((long)(a->Data()));
86  initRTimer();
87  return FALSE;
88}
89#endif
90static BOOLEAN jjMAXDEG(leftv, leftv a)
91{
92  Kstd1_deg=(int)((long)(a->Data()));
93  if (Kstd1_deg!=0)
94    test |=Sy_bit(OPT_DEGBOUND);
95  else
96    test &=(~Sy_bit(OPT_DEGBOUND));
97  return FALSE;
98}
99static BOOLEAN jjMAXMULT(leftv res, leftv a)
100{
101  Kstd1_mu=(int)((long)(a->Data()));
102  if (Kstd1_mu!=0)
103    test |=Sy_bit(OPT_MULTBOUND);
104  else
105    test &=(~Sy_bit(OPT_MULTBOUND));
106  return FALSE;
107}
108static BOOLEAN jjTRACE(leftv, leftv a)
109{
110  traceit=(int)((long)(a->Data()));
111  return FALSE;
112}
113static BOOLEAN jjSHORTOUT(leftv, leftv a)
114{
115  if (currRing != NULL)
116  {
117    BOOLEAN shortOut = (BOOLEAN)((long)a->Data());
118#if HAVE_CAN_SHORT_OUT
119    if (!shortOut)
120      currRing->ShortOut = 0;
121    else
122    {
123      if (currRing->CanShortOut)
124        currRing->ShortOut = 1;
125    }
126#else
127    currRing->ShortOut = shortOut;
128    coeffs cf = currRing->cf;
129    while (nCoeff_is_Extension(cf)) {
130      cf->extRing->ShortOut = shortOut;
131      assume(cf->extRing != NULL);
132      cf = cf->extRing->cf;
133    }
134#endif
135  }
136  return FALSE;
137}
138static void jjMINPOLY_red(idhdl h)
139{
140  switch(IDTYP(h))
141  {
142    case NUMBER_CMD:
143    {
144      number n=(number)IDDATA(h);
145      number one = nInit(1);
146      number nn=nMult(n,one);
147      nDelete(&n);nDelete(&one);
148      IDDATA(h)=(char*)nn;
149      break;
150    }
151    case VECTOR_CMD:
152    case POLY_CMD:
153    {
154      poly p=(poly)IDDATA(h);
155      IDDATA(h)=(char*)p_MinPolyNormalize(p, currRing);
156      break;
157    }
158    case IDEAL_CMD:
159    case MODUL_CMD:
160    case MAP_CMD:
161    case MATRIX_CMD:
162    {
163      int i;
164      ideal I=(ideal)IDDATA(h);
165      for(i=IDELEMS(I)-1;i>=0;i--)
166             I->m[i]=p_MinPolyNormalize(I->m[i], currRing);
167      break;
168    }
169    case LIST_CMD:
170    {
171      lists L=(lists)IDDATA(h);
172      int i=L->nr;
173      for(;i>=0;i--)
174      {
175        jjMINPOLY_red((idhdl)&(L->m[i]));
176      }
177    }
178    default:
179    //case RESOLUTION_CMD:
180       Werror("type %d too complex...set minpoly before",IDTYP(h)); break;
181  }
182}
183static BOOLEAN jjMINPOLY(leftv, leftv a)
184{
185  if( !nCoeff_is_transExt(currRing->cf) && (currRing->idroot == NULL) && n_IsZero((number)a->Data(), currRing->cf) )
186  {
187#ifndef NDEBUG
188    WarnS("Set minpoly over non-transcendental ground field to 0?!");
189#endif
190    return FALSE;
191  }
192
193
194  if ( !nCoeff_is_transExt(currRing->cf) )
195  {
196//    return TRUE;
197#ifndef NDEBUG
198    WarnS("Trying to set minpoly over non-transcendental ground field...");
199#endif
200  }
201
202  if ( currRing->idroot != NULL )
203  {
204//    return TRUE;
205#ifndef NDEBUG
206    idhdl p = currRing->idroot;
207
208    WarnS("no minpoly allowed if there are local objects belonging to the basering: ");
209
210    while(p != NULL)
211    {
212      PrintS(p->String(TRUE)); PrintLn();
213      p = p->next;
214    }
215#endif
216  }
217
218  assume (currRing->idroot==NULL);
219
220  number p = (number)a->CopyD(NUMBER_CMD);
221
222  if (n_IsZero(p, currRing->cf))
223  {
224    n_Delete(&p, currRing);
225
226
227    if( nCoeff_is_transExt(currRing->cf) )
228    {
229#ifndef NDEBUG
230      WarnS("minpoly is already 0...");
231#endif
232      return FALSE;
233    }
234
235    WarnS("cannot set minpoly to 0 / alg. extension?");
236
237//    return TRUE;
238  }
239
240  // remove all object currently in the ring
241  while(currRing->idroot!=NULL)
242  {
243#ifndef NDEBUG
244    Warn("killing a local object due to minpoly change: %s", IDID(currRing->idroot));
245#endif
246    killhdl2(currRing->idroot,&(currRing->idroot),currRing);
247  }
248
249  n_Normalize(p, currRing->cf);
250
251  assume( currRing->cf->extRing->qideal == NULL );
252
253  AlgExtInfo A;
254
255  A.r = rCopy(currRing->cf->extRing); // Copy  ground field!
256  ideal q = idInit(1,1);
257
258  assume( DEN((fractionObject *)(p)) == NULL ); // minpoly must be a poly...!?
259
260  q->m[0] = NUM((fractionObject *)p);
261  A.r->qideal = q;
262
263#if 0
264  PrintS("\nTrying to conver the currRing into an algebraic field: ");
265  PrintS("Ground poly. ring: \n");
266  rWrite( A.r );
267  PrintS("\nGiven MinPOLY: ");
268  p_Write( A.i->m[0], A.r );
269#endif
270
271  NUM((fractionObject *)p) = NULL; n_Delete(&p, currRing->cf);
272
273  coeffs new_cf = nInitChar(n_algExt, &A);
274
275  if (new_cf==NULL)
276  {
277    Werror("Could not construct the alg. extension: llegal minpoly?");
278    // cleanup A: TODO
279    rDelete( A.r );
280    return TRUE;
281  }
282  else
283  {
284    nKillChar(currRing->cf); currRing->cf=new_cf;
285  }
286
287  return FALSE;
288}
289static BOOLEAN jjNOETHER(leftv, leftv a)
290{
291  poly p=(poly)a->CopyD(POLY_CMD);
292  pDelete(&(currRing->ppNoether));
293  (currRing->ppNoether)=p;
294  return FALSE;
295}
296/*=================== proc =================*/
297static void jiAssignAttr(leftv l,leftv r)
298{
299  // get the attribute of th right side
300  // and set it to l
301  leftv rv=r->LData();
302  if (rv!=NULL)
303  {
304    if (rv->e==NULL)
305    {
306      if (rv->attribute!=NULL)
307      {
308        attr la;
309        if (r->rtyp!=IDHDL)
310        {
311          la=rv->attribute;
312          rv->attribute=NULL;
313        }
314        else
315        {
316          la=rv->attribute->Copy();
317        }
318        l->attribute=la;
319      }
320      l->flag=rv->flag;
321    }
322  }
323  if (l->rtyp==IDHDL)
324  {
325    idhdl h=(idhdl)l->data;
326    IDATTR(h)=l->attribute;
327    IDFLAG(h)=l->flag;
328  }
329}
330static BOOLEAN jiA_INT(leftv res, leftv a, Subexpr e)
331{
332  if (e==NULL)
333  {
334    res->data=(void *)a->Data();
335    jiAssignAttr(res,a);
336  }
337  else
338  {
339    int i=e->start-1;
340    if (i<0)
341    {
342      Werror("index[%d] must be positive",i+1);
343      return TRUE;
344    }
345    intvec *iv=(intvec *)res->data;
346    if (e->next==NULL)
347    {
348      if (i>=iv->length())
349      {
350        intvec *iv1=new intvec(i+1);
351        (*iv1)[i]=(int)((long)(a->Data()));
352        intvec *ivn=ivAdd(iv,iv1);
353        delete iv;
354        delete iv1;
355        res->data=(void *)ivn;
356      }
357      else
358        (*iv)[i]=(int)((long)(a->Data()));
359    }
360    else
361    {
362      int c=e->next->start;
363      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
364      {
365        Werror("wrong range [%d,%d] in intmat (%d,%d)",i+1,c,iv->rows(),iv->cols());
366        return TRUE;
367      }
368      else
369        IMATELEM(*iv,i+1,c) = (int)((long)(a->Data()));
370    }
371  }
372  return FALSE;
373}
374static BOOLEAN jiA_NUMBER(leftv res, leftv a, Subexpr e)
375{
376  number p=(number)a->CopyD(NUMBER_CMD);
377  if (res->data!=NULL) nDelete((number *)&res->data);
378  nNormalize(p);
379  res->data=(void *)p;
380  jiAssignAttr(res,a);
381  return FALSE;
382}
383static BOOLEAN jiA_BIGINT(leftv res, leftv a, Subexpr e)
384{
385  number p=(number)a->CopyD(BIGINT_CMD);
386  if (e==NULL)
387  {
388    if (res->data!=NULL) n_Delete((number *)&res->data,coeffs_BIGINT);
389    res->data=(void *)p;
390  }
391  else
392  {
393    int i=e->start-1;
394    if (i<0)
395    {
396      Werror("index[%d] must be positive",i+1);
397      return TRUE;
398    }
399    bigintmat *iv=(bigintmat *)res->data;
400    if (e->next==NULL)
401    {
402      WerrorS("only one index given");
403      return TRUE;
404    }
405    else
406    {
407      int c=e->next->start;
408      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
409      {
410        Werror("wrong range [%d,%d] in bigintmat (%d,%d)",i+1,c,iv->rows(),iv->cols());
411        return TRUE;
412      }
413      else
414      {
415        n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
416        BIMATELEM(*iv,i+1,c) = p;
417      }
418    }
419  }
420  jiAssignAttr(res,a);
421  return FALSE;
422}
423static BOOLEAN jiA_LIST_RES(leftv res, leftv a,Subexpr e)
424{
425  syStrategy r=(syStrategy)a->CopyD(RESOLUTION_CMD);
426  if (res->data!=NULL) ((lists)res->data)->Clean();
427  int add_row_shift = 0;
428  intvec *weights=(intvec*)atGet(a,"isHomog",INTVEC_CMD);
429  if (weights!=NULL)  add_row_shift=weights->min_in();
430  res->data=(void *)syConvRes(r,TRUE,add_row_shift);
431  //jiAssignAttr(res,a);
432  return FALSE;
433}
434static BOOLEAN jiA_LIST(leftv res, leftv a,Subexpr e)
435{
436  lists l=(lists)a->CopyD(LIST_CMD);
437  if (res->data!=NULL) ((lists)res->data)->Clean();
438  res->data=(void *)l;
439  jiAssignAttr(res,a);
440  return FALSE;
441}
442static BOOLEAN jiA_POLY(leftv res, leftv a,Subexpr e)
443{
444  poly p=(poly)a->CopyD(POLY_CMD);
445  pNormalize(p);
446  if (e==NULL)
447  {
448    if (res->data!=NULL) pDelete((poly*)&res->data);
449    res->data=(void*)p;
450    jiAssignAttr(res,a);
451    if (TEST_V_QRING && (currQuotient!=NULL) && (!hasFlag(res,FLAG_QRING))) jjNormalizeQRingP(res);
452  }
453  else
454  {
455    int i,j;
456    matrix m=(matrix)res->data;
457    i=e->start;
458    if (e->next==NULL)
459    {
460      j=i; i=1;
461      // for all ideal like data types: check indices
462      if (j>MATCOLS(m))
463      {
464        pEnlargeSet(&(m->m),MATCOLS(m),j-MATCOLS(m));
465        MATCOLS(m)=j;
466      }
467      else if (j<=0)
468      {
469        Werror("index[%d] must be positive",j/*e->start*/);
470        return TRUE;
471      }
472    }
473    else
474    {
475      // for matrices: indices are correct (see ipExprArith3(..,'['..) )
476      j=e->next->start;
477    }
478    pDelete(&MATELEM(m,i,j));
479    MATELEM(m,i,j)=p;
480    /* for module: update rank */
481    if ((p!=NULL) && (pGetComp(p)!=0))
482    {
483      m->rank=si_max(m->rank,pMaxComp(p));
484    }
485    if (TEST_V_QRING) jjNormalizeQRingP(res);
486  }
487  return FALSE;
488}
489static BOOLEAN jiA_1x1INTMAT(leftv res, leftv a,Subexpr e)
490{
491  if ((res->rtyp!=INTMAT_CMD) /*|| (e!=NULL) - TRUE because of type int */)
492  {
493    // no error message: assignment simply fails
494    return TRUE;
495  }
496  intvec* am=(intvec*)a->CopyD(INTMAT_CMD);
497  if ((am->rows()!=1) || (am->cols()!=1))
498  {
499    WerrorS("must be 1x1 intmat");
500    delete am;
501    return TRUE;
502  }
503  intvec* m=(intvec *)res->data;
504  // indices are correct (see ipExprArith3(..,'['..) )
505  int i=e->start;
506  int j=e->next->start;
507  IMATELEM(*m,i,j)=IMATELEM(*am,1,1);
508  delete am;
509  return FALSE;
510}
511static BOOLEAN jiA_1x1MATRIX(leftv res, leftv a,Subexpr e)
512{
513  if ((res->rtyp!=MATRIX_CMD) /*|| (e!=NULL) - TRUE because of type poly */)
514  {
515    // no error message: assignment simply fails
516    return TRUE;
517  }
518  matrix am=(matrix)a->CopyD(MATRIX_CMD);
519  if ((MATROWS(am)!=1) || (MATCOLS(am)!=1))
520  {
521    WerrorS("must be 1x1 matrix");
522    idDelete((ideal *)&am);
523    return TRUE;
524  }
525  matrix m=(matrix)res->data;
526  // indices are correct (see ipExprArith3(..,'['..) )
527  int i=e->start;
528  int j=e->next->start;
529  pDelete(&MATELEM(m,i,j));
530  pNormalize(MATELEM(am,1,1));
531  MATELEM(m,i,j)=MATELEM(am,1,1);
532  MATELEM(am,1,1)=NULL;
533  idDelete((ideal *)&am);
534  return FALSE;
535}
536static BOOLEAN jiA_STRING(leftv res, leftv a, Subexpr e)
537{
538  if (e==NULL)
539  {
540    void* tmp = res->data;
541    res->data=(void *)a->CopyD(STRING_CMD);
542    jiAssignAttr(res,a);
543    omfree(tmp);
544  }
545  else
546  {
547    char *s=(char *)res->data;
548    if ((e->start>0)&&(e->start<=(int)strlen(s)))
549      s[e->start-1]=(char)(*((char *)a->Data()));
550    else
551    {
552      Werror("string index %d out of range 1..%d",e->start,(int)strlen(s));
553      return TRUE;
554    }
555  }
556  return FALSE;
557}
558static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr e)
559{
560  extern procinfo *iiInitSingularProcinfo(procinfo *pi, const char *libname,
561                                          const char *procname, int line,
562                                          long pos, BOOLEAN pstatic=FALSE);
563  extern void piCleanUp(procinfov pi);
564
565  if(res->data!=NULL) piCleanUp((procinfo *)res->data);
566  if(a->rtyp==STRING_CMD)
567  {
568    res->data = (void *)omAlloc0Bin(procinfo_bin);
569    ((procinfo *)(res->data))->language=LANG_NONE;
570    iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
571    ((procinfo *)res->data)->data.s.body=(char *)a->CopyD(STRING_CMD);
572  }
573  else
574    res->data=(void *)a->CopyD(PROC_CMD);
575  jiAssignAttr(res,a);
576  return FALSE;
577}
578static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr e)
579{
580  //if ((res->data==NULL) || (res->Typ()==a->Typ()))
581  {
582    if (res->data!=NULL) delete ((intvec *)res->data);
583    res->data=(void *)a->CopyD(INTVEC_CMD);
584    jiAssignAttr(res,a);
585    return FALSE;
586  }
587#if 0
588  else
589  {
590    intvec *r=(intvec *)(res->data);
591    intvec *s=(intvec *)(a->Data());
592    int i=si_min(r->length(), s->length())-1;
593    for(;i>=0;i--)
594    {
595      (*r)[i]=(*s)[i];
596    }
597    return FALSE; //(r->length()< s->length());
598  }
599#endif
600}
601static BOOLEAN jiA_BIGINTMAT(leftv res, leftv a, Subexpr e)
602{
603  if (res->data!=NULL) delete ((bigintmat *)res->data);
604  res->data=(void *)a->CopyD(BIGINTMAT_CMD);
605  jiAssignAttr(res,a);
606  return FALSE;
607}
608static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr e)
609{
610  if (res->data!=NULL) idDelete((ideal*)&res->data);
611  res->data=(void *)a->CopyD(MATRIX_CMD);
612  if (a->rtyp==IDHDL) id_Normalize((ideal)a->Data(), currRing);
613  else                id_Normalize((ideal)res->data, currRing);
614  jiAssignAttr(res,a);
615  if (((res->rtyp==IDEAL_CMD)||(res->rtyp==MODUL_CMD))
616  && (IDELEMS((ideal)(res->data))==1)
617  && (currRing->qideal==NULL)
618  && (!rIsPluralRing(currRing))
619  )
620  {
621    setFlag(res,FLAG_STD);
622  }
623  if (TEST_V_QRING && (currQuotient!=NULL)&& (!hasFlag(res,FLAG_QRING))) jjNormalizeQRingId(res);
624  return FALSE;
625}
626static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr e)
627{
628  if (res->data!=NULL) syKillComputation((syStrategy)res->data);
629  res->data=(void *)a->CopyD(RESOLUTION_CMD);
630  jiAssignAttr(res,a);
631  return FALSE;
632}
633static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr e)
634{
635  if (res->data!=NULL) idDelete((ideal*)&res->data);
636  ideal I=idInit(1,1);
637  I->m[0]=(poly)a->CopyD(POLY_CMD);
638  if (I->m[0]!=NULL) pSetCompP(I->m[0],1);
639  pNormalize(I->m[0]);
640  res->data=(void *)I;
641  if (TEST_V_QRING && (currQuotient!=NULL))
642  {
643    if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
644    else                       jjNormalizeQRingId(res);
645  }
646  return FALSE;
647}
648static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr e)
649{
650  if (res->data!=NULL) idDelete((ideal*)&res->data);
651  matrix m=(matrix)a->CopyD(MATRIX_CMD);
652  IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m);
653  ((ideal)m)->rank=1;
654  MATROWS(m)=1;
655  id_Normalize((ideal)m, currRing);
656  res->data=(void *)m;
657  if (TEST_V_QRING && (currQuotient!=NULL)) jjNormalizeQRingId(res);
658  return FALSE;
659}
660static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr e)
661{
662  si_link l=(si_link)res->data;
663
664  if (l!=NULL) slCleanUp(l);
665
666  if (a->Typ() == STRING_CMD)
667  {
668    if (l == NULL)
669    {
670      l = (si_link) omAlloc0Bin(sip_link_bin);
671      res->data = (void *) l;
672    }
673    return slInit(l, (char *) a->Data());
674  }
675  else if (a->Typ() == LINK_CMD)
676  {
677    if (l != NULL) omFreeBin(l, sip_link_bin);
678    res->data = slCopy((si_link)a->Data());
679    return FALSE;
680  }
681  return TRUE;
682}
683// assign map -> map
684static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr e)
685{
686  if (res->data!=NULL)
687  {
688    omFree((ADDRESS)((map)res->data)->preimage);
689    ((map)res->data)->preimage=NULL;
690    idDelete((ideal*)&res->data);
691  }
692  res->data=(void *)a->CopyD(MAP_CMD);
693  jiAssignAttr(res,a);
694  return FALSE;
695}
696// assign ideal -> map
697static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr e)
698{
699  map f=(map)res->data;
700  char *rn=f->preimage; // save the old/already assigned preimage ring name
701  f->preimage=NULL;
702  idDelete((ideal *)&f);
703  res->data=(void *)a->CopyD(IDEAL_CMD);
704  f=(map)res->data;
705  id_Normalize((ideal)f, currRing);
706  f->preimage = rn;
707  return FALSE;
708}
709static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
710{
711  // the follwing can only happen, if:
712  //   - the left side is of type qring AND not an id
713  if ((e!=NULL)||(res->rtyp!=IDHDL))
714  {
715    WerrorS("qring_id expected");
716    return TRUE;
717  }
718
719  ring qr;
720  //qr=(ring)res->Data();
721  //if (qr!=NULL) omFreeBin((ADDRESS)qr, ip_sring_bin);
722  assume(res->Data()==NULL);
723  qr=rCopy(currRing);
724                 // we have to fill it, but the copy also allocates space
725  idhdl h=(idhdl)res->data; // we have res->rtyp==IDHDL
726  IDRING(h)=qr;
727
728  ideal id=(ideal)a->CopyD(IDEAL_CMD);
729
730  if ((idElem(id)>1) || rIsSCA(currRing) || (currRing->qideal!=NULL))
731    assumeStdFlag(a);
732
733#ifdef HAVE_RINGS
734  if (rField_is_Ring(currRing))
735  {
736    if (idPosConstant(id) != -1)
737    {
738      WerrorS("constant in q-ideal; please modify ground field/ring instead");
739      return TRUE;
740    }
741  }
742#endif
743
744  if (currRing->qideal!=NULL) /* we are already in a qring! */
745  {
746    ideal tmp=idSimpleAdd(id,currRing->qideal);
747    // both ideals should be GB, so dSimpleAdd is sufficient
748    idDelete(&id);
749    id=tmp;
750    // delete the qr copy of quotient ideal!!!
751    idDelete(&qr->qideal);
752  }
753  qr->qideal = id;
754
755  // qr is a copy of currRing with the new qideal!
756  #ifdef HAVE_PLURAL
757  if(rIsPluralRing(currRing))
758  {
759    if (!hasFlag(a,FLAG_TWOSTD))
760    {
761      Warn("%s is no twosided standard basis",a->Name());
762    }
763
764    if( nc_SetupQuotient(qr, currRing) )
765    {
766//      WarnS("error in nc_SetupQuotient");
767    }
768  }
769  #endif
770  rSetHdl((idhdl)res->data);
771  return FALSE;
772}
773
774static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e)
775{
776  BOOLEAN have_id=TRUE;
777  if ((e!=NULL)||(res->rtyp!=IDHDL))
778  {
779    //WerrorS("id expected");
780    //return TRUE;
781    have_id=FALSE;
782  }
783  ring r=(ring)a->Data();
784  if (have_id)
785  {
786    idhdl rl=(idhdl)res->data;
787    if (IDRING(rl)!=NULL) rKill(rl);
788    IDRING(rl)=r;
789    if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing))
790      currRingHdl=(idhdl)res->data;
791  }
792  else
793  {
794    if (e==NULL) res->data=(char *)r;
795    else
796    {
797      WerrorS("id expected");
798      return TRUE;
799    }
800  }
801  r->ref++;
802  jiAssignAttr(res,a);
803  return FALSE;
804}
805static BOOLEAN jiA_PACKAGE(leftv res, leftv a, Subexpr e)
806{
807  res->data=(void *)a->CopyD(PACKAGE_CMD);
808  jiAssignAttr(res,a);
809  return FALSE;
810}
811/*=================== table =================*/
812#define IPASSIGN
813#define D(A) A
814#include "table.h"
815/*=================== operations ============================*/
816/*2
817* assign a = b
818*/
819static BOOLEAN jiAssign_1(leftv l, leftv r)
820{
821  int rt=r->Typ();
822  if (rt==0)
823  {
824    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
825    return TRUE;
826  }
827
828  int lt=l->Typ();
829  if((lt==0)/*&&(l->name!=NULL)*/)
830  {
831    if (!errorreported) Werror("left side `%s` is undefined",l->Fullname());
832    return TRUE;
833  }
834  if((rt==DEF_CMD)||(rt==NONE))
835  {
836    WarnS("right side is not a datum, assignment ignored");
837    // if (!errorreported)
838    //   WerrorS("right side is not a datum");
839    //return TRUE;
840    return FALSE;
841  }
842
843  int i=0;
844  if (lt==DEF_CMD)
845  {
846    if (l->rtyp==IDHDL)
847    {
848      IDTYP((idhdl)l->data)=rt;
849    }
850    else if (l->name!=NULL)
851    {
852      sleftv ll;
853      iiDeclCommand(&ll,l,myynest,rt,&IDROOT);
854      memcpy(l,&ll,sizeof(sleftv));
855    }
856    else
857    {
858      l->rtyp=rt;
859    }
860    lt=rt;
861  }
862  else
863  {
864    if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
865      return FALSE;
866  }
867  leftv ld=l;
868  if ((l->rtyp==IDHDL)&&(lt!=QRING_CMD)&&(lt!=RING_CMD))
869    ld=(leftv)l->data;
870  if (lt>MAX_TOK)
871  {
872    blackbox *bb=getBlackboxStuff(lt);
873#ifdef BLACKBOX_DEVEL
874    Print("bb-assign: bb=%lx\n",bb);
875#endif
876    return (bb==NULL) || bb->blackbox_Assign(l,r);
877  }
878  while (((dAssign[i].res!=lt)
879      || (dAssign[i].arg!=rt))
880    && (dAssign[i].res!=0)) i++;
881  if (dAssign[i].res!=0)
882  {
883    if (TEST_V_ALLWARN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt));
884    BOOLEAN b;
885    b=dAssign[i].p(ld,r,l->e);
886    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
887    {
888      l->flag=ld->flag;
889      l->attribute=ld->attribute;
890    }
891    return b;
892  }
893  // implicite type conversion ----------------------------------------------
894  if (dAssign[i].res==0)
895  {
896    int ri;
897    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
898    BOOLEAN failed=FALSE;
899    i=0;
900    while ((dAssign[i].res!=lt)
901      && (dAssign[i].res!=0)) i++;
902    while (dAssign[i].res==lt)
903    {
904      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
905      {
906        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
907        if(!failed)
908        {
909          failed= dAssign[i].p(ld,rn,l->e);
910          if (TEST_V_ALLWARN)
911            Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed);
912        }
913        // everything done, clean up temp. variables
914        rn->CleanUp();
915        omFreeBin((ADDRESS)rn, sleftv_bin);
916        if (failed)
917        {
918          // leave loop, goto error handling
919          break;
920        }
921        else
922        {
923          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
924          {
925            l->flag=ld->flag;
926            l->attribute=ld->attribute;
927          }
928          // everything ok, return
929          return FALSE;
930        }
931     }
932     i++;
933    }
934    // error handling ---------------------------------------------------
935    if (!errorreported)
936    {
937      if ((l->rtyp==IDHDL) && (l->e==NULL))
938        Werror("`%s`(%s) = `%s` is not supported",
939          Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
940      else
941         Werror("`%s` = `%s` is not supported"
942             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
943      if (BVERBOSE(V_SHOW_USE))
944      {
945        i=0;
946        while ((dAssign[i].res!=lt)
947          && (dAssign[i].res!=0)) i++;
948        while (dAssign[i].res==lt)
949        {
950          Werror("expected `%s` = `%s`"
951              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
952          i++;
953        }
954      }
955    }
956  }
957  return TRUE;
958}
959/*2
960* assign sys_var = val
961*/
962static BOOLEAN iiAssign_sys(leftv l, leftv r)
963{
964  int rt=r->Typ();
965
966  if (rt==0)
967  {
968    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
969    return TRUE;
970  }
971  int i=0;
972  int lt=l->rtyp;
973  while (((dAssign_sys[i].res!=lt)
974      || (dAssign_sys[i].arg!=rt))
975    && (dAssign_sys[i].res!=0)) i++;
976  if (dAssign_sys[i].res!=0)
977  {
978    if (!dAssign_sys[i].p(l,r))
979    {
980      // everything ok, clean up
981      return FALSE;
982    }
983  }
984  // implicite type conversion ----------------------------------------------
985  if (dAssign_sys[i].res==0)
986  {
987    int ri;
988    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
989    BOOLEAN failed=FALSE;
990    i=0;
991    while ((dAssign_sys[i].res!=lt)
992      && (dAssign_sys[i].res!=0)) i++;
993    while (dAssign_sys[i].res==lt)
994    {
995      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
996      {
997        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
998            || (dAssign_sys[i].p(l,rn)));
999        // everything done, clean up temp. variables
1000        rn->CleanUp();
1001        omFreeBin((ADDRESS)rn, sleftv_bin);
1002        if (failed)
1003        {
1004          // leave loop, goto error handling
1005          break;
1006        }
1007        else
1008        {
1009          // everything ok, return
1010          return FALSE;
1011        }
1012     }
1013     i++;
1014    }
1015    // error handling ---------------------------------------------------
1016    if(!errorreported)
1017    {
1018      Werror("`%s` = `%s` is not supported"
1019             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1020      if (BVERBOSE(V_SHOW_USE))
1021      {
1022        i=0;
1023        while ((dAssign_sys[i].res!=lt)
1024          && (dAssign_sys[i].res!=0)) i++;
1025        while (dAssign_sys[i].res==lt)
1026        {
1027          Werror("expected `%s` = `%s`"
1028              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
1029          i++;
1030        }
1031      }
1032    }
1033  }
1034  return TRUE;
1035}
1036static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
1037{
1038  /* right side is intvec, left side is list (of int)*/
1039  BOOLEAN nok;
1040  int i=0;
1041  leftv l1=l;
1042  leftv h;
1043  sleftv t;
1044  intvec *iv=(intvec *)r->Data();
1045  memset(&t,0,sizeof(sleftv));
1046  t.rtyp=INT_CMD;
1047  while ((i<iv->length())&&(l!=NULL))
1048  {
1049    t.data=(char *)(*iv)[i];
1050    h=l->next;
1051    l->next=NULL;
1052    nok=jiAssign_1(l,&t);
1053    l->next=h;
1054    if (nok) return TRUE;
1055    i++;
1056    l=h;
1057  }
1058  l1->CleanUp();
1059  r->CleanUp();
1060  return FALSE;
1061}
1062static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
1063{
1064  /* right side is vector, left side is list (of poly)*/
1065  BOOLEAN nok;
1066  leftv l1=l;
1067  ideal I=idVec2Ideal((poly)r->Data());
1068  leftv h;
1069  sleftv t;
1070  int i=0;
1071  while (l!=NULL)
1072  {
1073    memset(&t,0,sizeof(sleftv));
1074    t.rtyp=POLY_CMD;
1075    if (i>=IDELEMS(I))
1076    {
1077      t.data=NULL;
1078    }
1079    else
1080    {
1081      t.data=(char *)I->m[i];
1082      I->m[i]=NULL;
1083    }
1084    h=l->next;
1085    l->next=NULL;
1086    nok=jiAssign_1(l,&t);
1087    l->next=h;
1088    t.CleanUp();
1089    if (nok)
1090    {
1091      idDelete(&I);
1092      return TRUE;
1093    }
1094    i++;
1095    l=h;
1096  }
1097  idDelete(&I);
1098  l1->CleanUp();
1099  r->CleanUp();
1100  //if (TEST_V_QRING && (currQuotient!=NULL)) jjNormalizeQRingP(l);
1101  return FALSE;
1102}
1103static BOOLEAN jjA_L_LIST(leftv l, leftv r)
1104/* left side: list/def, has to be a "real" variable
1105*  right side: expression list
1106*/
1107{
1108  int sl = r->listLength();
1109  lists L=(lists)omAllocBin(slists_bin);
1110  lists oldL;
1111  leftv h=NULL,o_r=r;
1112  int i;
1113  int rt;
1114
1115  L->Init(sl);
1116  for (i=0;i<sl;i++)
1117  {
1118    if (h!=NULL) { /* e.g. not in the first step:
1119                   * h is the pointer to the old sleftv,
1120                   * r is the pointer to the next sleftv
1121                   * (in this moment) */
1122                   h->next=r;
1123                 }
1124    h=r;
1125    r=r->next;
1126    h->next=NULL;
1127    rt=h->Typ();
1128    if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
1129    {
1130      L->Clean();
1131      Werror("`%s` is undefined",h->Fullname());
1132      //listall();
1133      goto err;
1134    }
1135    //if ((rt==RING_CMD)||(rt==QRING_CMD))
1136    //{
1137    //  L->m[i].rtyp=rt;
1138    //  L->m[i].data=h->Data();
1139    //  ((ring)L->m[i].data)->ref++;
1140    //}
1141    //else
1142      L->m[i].CleanUp();
1143      L->m[i].Copy(h);
1144      if(errorreported)
1145      {
1146        L->Clean();
1147        goto err;
1148      }
1149  }
1150  oldL=(lists)l->Data();
1151  if (oldL!=NULL) oldL->Clean();
1152  if (l->rtyp==IDHDL)
1153  {
1154    IDLIST((idhdl)l->data)=L;
1155    IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1156    ipMoveId((idhdl)l->data);
1157  }
1158  else
1159  {
1160    l->LData()->data=L;
1161    if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1162      l->rtyp=LIST_CMD;
1163  }
1164err:
1165  o_r->CleanUp();
1166  return errorreported;
1167}
1168static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1169{
1170  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1171  leftv hh=r;
1172  int i = 0;
1173  while (hh!=NULL)
1174  {
1175    if (i>=iv->length())
1176    {
1177      if (TEST_V_ALLWARN)
1178      {
1179        Warn("expression list length(%d) does not match intmat size(%d)",
1180             iv->length()+exprlist_length(hh),iv->length());
1181      }
1182      break;
1183    }
1184    if (hh->Typ() == INT_CMD)
1185    {
1186      (*iv)[i++] = (int)((long)(hh->Data()));
1187    }
1188    else if ((hh->Typ() == INTVEC_CMD)
1189            ||(hh->Typ() == INTMAT_CMD))
1190    {
1191      intvec *ivv = (intvec *)(hh->Data());
1192      int ll = 0,l = si_min(ivv->length(),iv->length());
1193      for (; l>0; l--)
1194      {
1195        (*iv)[i++] = (*ivv)[ll++];
1196      }
1197    }
1198    else
1199    {
1200      delete iv;
1201      return TRUE;
1202    }
1203    hh = hh->next;
1204  }
1205  if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1206  IDINTVEC((idhdl)l->data)=iv;
1207  return FALSE;
1208}
1209static BOOLEAN jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat *bim)
1210{
1211  /* left side is bigintmat, right side is list (of int,intvec,intmat)*/
1212  leftv hh=r;
1213  int i = 0;
1214  if (bim->length()==0) { WerrorS("bigintmat is 1x0"); delete bim; return TRUE; }
1215  while (hh!=NULL)
1216  {
1217    if (i>=bim->cols()*bim->rows())
1218    {
1219      if (TEST_V_ALLWARN)
1220      {
1221        Warn("expression list length(%d) does not match bigintmat size(%d x %d)",
1222              exprlist_length(hh),bim->rows(),bim->cols());
1223      }
1224      break;
1225    }
1226    if (hh->Typ() == INT_CMD)
1227    {
1228      number tp = n_Init((int)((long)(hh->Data())), coeffs_BIGINT);
1229      bim->set(i++, tp);
1230      n_Delete(&tp, coeffs_BIGINT);
1231    }
1232    else if (hh->Typ() == BIGINT_CMD)
1233    {
1234      bim->set(i++, (number)(hh->Data()));
1235    }
1236    /*
1237    ((hh->Typ() == INTVEC_CMD)
1238            ||(hh->Typ() == INTMAT_CMD))
1239    {
1240      intvec *ivv = (intvec *)(hh->Data());
1241      int ll = 0,l = si_min(ivv->length(),iv->length());
1242      for (; l>0; l--)
1243      {
1244        (*iv)[i++] = (*ivv)[ll++];
1245      }
1246    }*/
1247    else
1248    {
1249      delete bim;
1250      return TRUE;
1251    }
1252    hh = hh->next;
1253  }
1254  if (IDBIMAT((idhdl)l->data)!=NULL) delete IDBIMAT((idhdl)l->data);
1255  IDBIMAT((idhdl)l->data)=bim;
1256  return FALSE;
1257}
1258static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1259{
1260  /* left side is string, right side is list of string*/
1261  leftv hh=r;
1262  int sl = 1;
1263  char *s;
1264  char *t;
1265  int tl;
1266  /* find the length */
1267  while (hh!=NULL)
1268  {
1269    if (hh->Typ()!= STRING_CMD)
1270    {
1271      return TRUE;
1272    }
1273    sl += strlen((char *)hh->Data());
1274    hh = hh->next;
1275  }
1276  s = (char * )omAlloc(sl);
1277  sl=0;
1278  hh = r;
1279  while (hh!=NULL)
1280  {
1281    t=(char *)hh->Data();
1282    tl=strlen(t);
1283    memcpy(s+sl,t,tl);
1284    sl+=tl;
1285    hh = hh->next;
1286  }
1287  s[sl]='\0';
1288  omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1289  IDDATA((idhdl)(l->data))=s;
1290  return FALSE;
1291}
1292static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1293{
1294  /* right side is matrix, left side is list (of poly)*/
1295  BOOLEAN nok=FALSE;
1296  int i;
1297  matrix m=(matrix)r->CopyD(MATRIX_CMD);
1298  leftv h;
1299  leftv ol=l;
1300  leftv o_r=r;
1301  sleftv t;
1302  memset(&t,0,sizeof(sleftv));
1303  t.rtyp=POLY_CMD;
1304  int mxn=MATROWS(m)*MATCOLS(m);
1305  loop
1306  {
1307    i=0;
1308    while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1309    {
1310      t.data=(char *)m->m[i];
1311      m->m[i]=NULL;
1312      h=l->next;
1313      l->next=NULL;
1314      nok=jiAssign_1(l,&t);
1315      l->next=h;
1316      if (nok)
1317      {
1318        idDelete((ideal *)&m);
1319        goto ende;
1320      }
1321      i++;
1322      l=h;
1323    }
1324    idDelete((ideal *)&m);
1325    h=r;
1326    r=r->next;
1327    if (l==NULL)
1328    {
1329      if (r!=NULL)
1330      {
1331        Warn("list length mismatch in assign (l>r)");
1332        nok=TRUE;
1333      }
1334      break;
1335    }
1336    else if (r==NULL)
1337    {
1338      Warn("list length mismatch in assign (l<r)");
1339      nok=TRUE;
1340      break;
1341    }
1342    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1343    {
1344      m=(matrix)r->CopyD(MATRIX_CMD);
1345      mxn=MATROWS(m)*MATCOLS(m);
1346    }
1347    else if (r->Typ()==POLY_CMD)
1348    {
1349      m=mpNew(1,1);
1350      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1351      pNormalize(MATELEM(m,1,1));
1352      mxn=1;
1353    }
1354    else
1355    {
1356      nok=TRUE;
1357      break;
1358    }
1359  }
1360ende:
1361  o_r->CleanUp();
1362  ol->CleanUp();
1363  return nok;
1364}
1365static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1366{
1367  /*left side are strings, right side is a string*/
1368  /*e.g. s[2..3]="12" */
1369  /*the case s=t[1..4] is handled in iiAssign,
1370  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1371  BOOLEAN nok=FALSE;
1372  sleftv t;
1373  leftv h,l1=l;
1374  int i=0;
1375  char *ss;
1376  char *s=(char *)r->Data();
1377  int sl=strlen(s);
1378
1379  memset(&t,0,sizeof(sleftv));
1380  t.rtyp=STRING_CMD;
1381  while ((i<sl)&&(l!=NULL))
1382  {
1383    ss=(char *)omAlloc(2);
1384    ss[1]='\0';
1385    ss[0]=s[i];
1386    t.data=ss;
1387    h=l->next;
1388    l->next=NULL;
1389    nok=jiAssign_1(l,&t);
1390    if (nok)
1391    {
1392      break;
1393    }
1394    i++;
1395    l=h;
1396  }
1397  r->CleanUp();
1398  l1->CleanUp();
1399  return nok;
1400}
1401static BOOLEAN jiAssign_list(leftv l, leftv r)
1402{
1403  int i=l->e->start-1;
1404  if (i<0)
1405  {
1406    Werror("index[%d] must be positive",i+1);
1407    return TRUE;
1408  }
1409  if(l->attribute!=NULL)
1410  {
1411    atKillAll((idhdl)l);
1412    l->attribute=NULL;
1413  }
1414  l->flag=0;
1415  lists li;
1416  if (l->rtyp==IDHDL)
1417  {
1418    li=IDLIST((idhdl)l->data);
1419  }
1420  else
1421  {
1422    li=(lists)l->data;
1423  }
1424  if (i>li->nr)
1425  {
1426    li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1427    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1428    int j=li->nr+1;
1429    for(;j<=i;j++)
1430      li->m[j].rtyp=DEF_CMD;
1431    li->nr=i;
1432  }
1433  leftv ld=&(li->m[i]);
1434  ld->e=l->e->next;
1435  BOOLEAN b;
1436  if (/*(ld->rtyp!=LIST_CMD)
1437  &&*/(ld->e==NULL)
1438  &&(ld->Typ()!=r->Typ()))
1439  {
1440    sleftv tmp;
1441    memset(&tmp,0,sizeof(sleftv));
1442    tmp.rtyp=DEF_CMD;
1443    b=iiAssign(&tmp,r);
1444    ld->CleanUp();
1445    memcpy(ld,&tmp,sizeof(sleftv));
1446  }
1447  else
1448  {
1449    b=iiAssign(ld,r);
1450    if (l->e!=NULL) l->e->next=ld->e;
1451    ld->e=NULL;
1452  }
1453  return b;
1454}
1455static BOOLEAN jiAssign_rec(leftv l, leftv r)
1456{
1457  leftv l1=l;
1458  leftv r1=r;
1459  leftv lrest;
1460  leftv rrest;
1461  BOOLEAN b;
1462  do
1463  {
1464    lrest=l->next;
1465    rrest=r->next;
1466    l->next=NULL;
1467    r->next=NULL;
1468    b=iiAssign(l,r);
1469    l->next=lrest;
1470    r->next=rrest;
1471    l=lrest;
1472    r=rrest;
1473  } while  ((!b)&&(l!=NULL));
1474  l1->CleanUp();
1475  r1->CleanUp();
1476  return b;
1477}
1478BOOLEAN iiAssign(leftv l, leftv r)
1479{
1480  if (errorreported) return TRUE;
1481  int ll=l->listLength();
1482  int rl;
1483  int lt=l->Typ();
1484  int rt=NONE;
1485  BOOLEAN b;
1486  if (l->rtyp==ALIAS_CMD)
1487  {
1488    Werror("`%s` is read-only",l->Name());
1489  }
1490
1491  if (l->rtyp==IDHDL)
1492  {
1493    atKillAll((idhdl)l->data);
1494    IDFLAG((idhdl)l->data)=0;
1495    l->attribute=NULL;
1496  }
1497  else if (l->attribute!=NULL)
1498    atKillAll((idhdl)l);
1499  l->flag=0;
1500  if (ll==1)
1501  {
1502    /* l[..] = ... */
1503    if(l->e!=NULL)
1504    {
1505      BOOLEAN like_lists=0;
1506      blackbox *bb=NULL;
1507      int bt;
1508      if (((bt=l->rtyp)>MAX_TOK)
1509      || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1510      {
1511        bb=getBlackboxStuff(bt);
1512        like_lists=BB_LIKE_LIST(bb); // bb like a list
1513      }
1514      else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1515        || (l->rtyp==LIST_CMD))
1516      {
1517        like_lists=2; // bb in a list
1518      }
1519      if(like_lists)
1520      {
1521        if (TEST_V_ALLWARN) PrintS("assign list[..]=...or similiar\n");
1522        if (like_lists==1)
1523        {
1524          // check blackbox/newtype type:
1525          if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
1526        }
1527        b=jiAssign_list(l,r);
1528        if((!b) && (like_lists==2))
1529        {
1530          //Print("jjA_L_LIST: - 2 \n");
1531          if((l->rtyp==IDHDL) && (l->data!=NULL))
1532          {
1533            ipMoveId((idhdl)l->data);
1534            l->attribute=IDATTR((idhdl)l->data);
1535            l->flag=IDFLAG((idhdl)l->data);
1536          }
1537        }
1538        r->CleanUp();
1539        Subexpr h;
1540        while (l->e!=NULL)
1541        {
1542          h=l->e->next;
1543          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1544          l->e=h;
1545        }
1546        return b;
1547      }
1548    }
1549    // end of handling elems of list and similiar
1550    rl=r->listLength();
1551    if (rl==1)
1552    {
1553      /* system variables = ... */
1554      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1555      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1556      {
1557        b=iiAssign_sys(l,r);
1558        r->CleanUp();
1559        //l->CleanUp();
1560        return b;
1561      }
1562      rt=r->Typ();
1563      /* a = ... */
1564      if ((lt!=MATRIX_CMD)
1565      &&(lt!=INTMAT_CMD)
1566      &&((lt==rt)||(lt!=LIST_CMD)))
1567      {
1568        b=jiAssign_1(l,r);
1569        if (l->rtyp==IDHDL)
1570        {
1571          if ((lt==DEF_CMD)||(lt==LIST_CMD))
1572          {
1573            ipMoveId((idhdl)l->data);
1574          }
1575          l->attribute=IDATTR((idhdl)l->data);
1576          l->flag=IDFLAG((idhdl)l->data);
1577          l->CleanUp();
1578        }
1579        r->CleanUp();
1580        return b;
1581      }
1582      if (((lt!=LIST_CMD)
1583        &&((rt==MATRIX_CMD)
1584          ||(rt==INTMAT_CMD)
1585          ||(rt==INTVEC_CMD)
1586          ||(rt==MODUL_CMD)))
1587      ||((lt==LIST_CMD)
1588        &&(rt==RESOLUTION_CMD))
1589      )
1590      {
1591        b=jiAssign_1(l,r);
1592        if((l->rtyp==IDHDL)&&(l->data!=NULL))
1593        {
1594          if ((lt==DEF_CMD) || (lt==LIST_CMD))
1595          {
1596            //Print("ipAssign - 3.0\n");
1597            ipMoveId((idhdl)l->data);
1598          }
1599          l->attribute=IDATTR((idhdl)l->data);
1600          l->flag=IDFLAG((idhdl)l->data);
1601        }
1602        r->CleanUp();
1603        Subexpr h;
1604        while (l->e!=NULL)
1605        {
1606          h=l->e->next;
1607          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1608          l->e=h;
1609        }
1610        return b;
1611      }
1612    }
1613    if (rt==NONE) rt=r->Typ();
1614  }
1615  else if (ll==(rl=r->listLength()))
1616  {
1617    b=jiAssign_rec(l,r);
1618    return b;
1619  }
1620  else
1621  {
1622    if (rt==NONE) rt=r->Typ();
1623    if (rt==INTVEC_CMD)
1624      return jiA_INTVEC_L(l,r);
1625    else if (rt==VECTOR_CMD)
1626      return jiA_VECTOR_L(l,r);
1627    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1628      return jiA_MATRIX_L(l,r);
1629    else if ((rt==STRING_CMD)&&(rl==1))
1630      return jiA_STRING_L(l,r);
1631    Werror("length of lists in assignment does not match (l:%d,r:%d)",
1632      ll,rl);
1633    return TRUE;
1634  }
1635
1636  leftv hh=r;
1637  BOOLEAN nok=FALSE;
1638  BOOLEAN map_assign=FALSE;
1639  switch (lt)
1640  {
1641    case INTVEC_CMD:
1642      nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
1643      break;
1644    case INTMAT_CMD:
1645    {
1646      nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
1647      break;
1648    }
1649    case BIGINTMAT_CMD:
1650    {
1651      nok=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
1652      break;
1653    }
1654    case MAP_CMD:
1655    {
1656      // first element in the list sl (r) must be a ring
1657      if (((rt == RING_CMD)||(rt == QRING_CMD))&&(r->e==NULL))
1658      {
1659        omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
1660        IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
1661        /* advance the expressionlist to get the next element after the ring */
1662        hh = r->next;
1663        //r=hh;
1664      }
1665      else
1666      {
1667        WerrorS("expected ring-name");
1668        nok=TRUE;
1669        break;
1670      }
1671      if (hh==NULL) /* map-assign: map f=r; */
1672      {
1673        WerrorS("expected image ideal");
1674        nok=TRUE;
1675        break;
1676      }
1677      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
1678        return jiAssign_1(l,hh); /* map-assign: map f=r,i; */
1679      //no break, handle the rest like an ideal:
1680      map_assign=TRUE;
1681    }
1682    case MATRIX_CMD:
1683    case IDEAL_CMD:
1684    case MODUL_CMD:
1685    {
1686      sleftv t;
1687      matrix olm = (matrix)l->Data();
1688      int rk=olm->rank;
1689      char *pr=((map)olm)->preimage;
1690      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
1691      matrix lm ;
1692      int  num;
1693      int j,k;
1694      int i=0;
1695      int mtyp=MATRIX_CMD; /*Type of left side object*/
1696      int etyp=POLY_CMD;   /*Type of elements of left side object*/
1697
1698      if (lt /*l->Typ()*/==MATRIX_CMD)
1699      {
1700        num=olm->cols()*olm->rows();
1701        lm=mpNew(olm->rows(),olm->cols());
1702        int el;
1703        if ((TEST_V_ALLWARN) && (num!=(el=exprlist_length(hh))))
1704        {
1705          Warn("expression list length(%d) does not match matrix size(%d)",el,num);
1706        }
1707      }
1708      else /* IDEAL_CMD or MODUL_CMD */
1709      {
1710        num=exprlist_length(hh);
1711        lm=(matrix)idInit(num,1);
1712        rk=1;
1713        if (module_assign)
1714        {
1715          mtyp=MODUL_CMD;
1716          etyp=VECTOR_CMD;
1717        }
1718      }
1719
1720      int ht;
1721      loop
1722      {
1723        if (hh==NULL)
1724          break;
1725        else
1726        {
1727          matrix rm;
1728          ht=hh->Typ();
1729          if ((j=iiTestConvert(ht,etyp))!=0)
1730          {
1731            nok=iiConvert(ht,etyp,j,hh,&t);
1732            hh->next=t.next;
1733            if (nok) break;
1734            lm->m[i]=(poly)t.CopyD(etyp);
1735            pNormalize(lm->m[i]);
1736            if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
1737            i++;
1738          }
1739          else
1740          if ((j=iiTestConvert(ht,mtyp))!=0)
1741          {
1742            nok=iiConvert(ht,mtyp,j,hh,&t);
1743            hh->next=t.next;
1744            if (nok) break;
1745            rm = (matrix)t.CopyD(mtyp);
1746            if (module_assign)
1747            {
1748              j = si_min(num,rm->cols());
1749              rk=si_max(rk,(int)rm->rank);
1750            }
1751            else
1752              j = si_min(num-i,rm->rows() * rm->cols());
1753            for(k=0;k<j;k++,i++)
1754            {
1755              lm->m[i]=rm->m[k];
1756              pNormalize(lm->m[i]);
1757              rm->m[k]=NULL;
1758            }
1759            idDelete((ideal *)&rm);
1760          }
1761          else
1762          {
1763            nok=TRUE;
1764            break;
1765          }
1766          t.next=NULL;t.CleanUp();
1767          if (i==num) break;
1768          hh=hh->next;
1769        }
1770      }
1771      if (nok)
1772        idDelete((ideal *)&lm);
1773      else
1774      {
1775        idDelete((ideal *)&olm);
1776        if (module_assign)   lm->rank=rk;
1777        else if (map_assign) ((map)lm)->preimage=pr;
1778        l=l->LData();
1779        if (l->rtyp==IDHDL)
1780          IDMATRIX((idhdl)l->data)=lm;
1781        else
1782          l->data=(char *)lm;
1783      }
1784      break;
1785    }
1786    case STRING_CMD:
1787      nok=jjA_L_STRING(l,r);
1788      break;
1789    case DEF_CMD:
1790    case LIST_CMD:
1791      nok=jjA_L_LIST(l,r);
1792      break;
1793    case NONE:
1794    case 0:
1795      Werror("cannot assign to %s",l->Fullname());
1796      nok=TRUE;
1797      break;
1798    default:
1799      WerrorS("assign not impl.");
1800      nok=TRUE;
1801      break;
1802  } /* end switch: typ */
1803  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
1804  r->CleanUp();
1805  return nok;
1806}
1807void jjNormalizeQRingId(leftv I)
1808{
1809  if ((currQuotient!=NULL) && (!hasFlag(I,FLAG_QRING)))
1810  {
1811    if (I->e==NULL)
1812    {
1813      ideal I0=(ideal)I->Data();
1814      switch (I->Typ())
1815      {
1816        case IDEAL_CMD:
1817        case MODUL_CMD:
1818        {
1819          ideal F=idInit(1,1);
1820          ideal II=kNF(F,currQuotient,I0);
1821          idDelete(&F);
1822          if (I->rtyp!=IDHDL)
1823          {
1824            idDelete((ideal*)&(I0));
1825            I->data=II;
1826          }
1827          else
1828          {
1829            idhdl h=(idhdl)I->data;
1830            idDelete((ideal*)&IDIDEAL(h));
1831            IDIDEAL(h)=II;
1832            setFlag(h,FLAG_QRING);
1833          }
1834          break;
1835        }
1836        default: break;
1837      }
1838      setFlag(I,FLAG_QRING);
1839    }
1840  }
1841}
1842void jjNormalizeQRingP(leftv I)
1843{
1844  if ((currQuotient!=NULL) && (!hasFlag(I,FLAG_QRING)))
1845  {
1846    poly p=(poly)I->Data();
1847    if ((I->e==NULL) && (p!=NULL))
1848    {
1849      ideal F=idInit(1,1);
1850      poly II=kNF(F,currQuotient,p);
1851      idDelete(&F);
1852      if ((I->rtyp==POLY_CMD)
1853      || (I->rtyp==VECTOR_CMD))
1854      {
1855        pDelete(&p);
1856        I->data=II;
1857      }
1858      else if (I->rtyp==IDHDL)
1859      {
1860        pDelete(&p);
1861        idhdl h=(idhdl)I->data;
1862        IDPOLY(h)=II;
1863        setFlag(h,FLAG_QRING);
1864      }
1865      else
1866      {
1867        pDelete(&II);
1868      }
1869    }
1870    setFlag(I,FLAG_QRING);
1871  }
1872}
1873BOOLEAN jjIMPORTFROM(leftv res, leftv u, leftv v)
1874{
1875  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
1876  assume(u->Typ()==PACKAGE_CMD);
1877  char *vn=(char *)v->Name();
1878  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
1879  if (h!=NULL)
1880  {
1881    //check for existence
1882    if (((package)(u->Data()))==basePack)
1883    {
1884      WarnS("source and destination packages are identical");
1885      return FALSE;
1886    }
1887    idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
1888    if (t!=NULL)
1889    {
1890      Warn("redefining `%s`",vn);
1891      killhdl(t);
1892    }
1893    sleftv tmp_expr;
1894    if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
1895    sleftv h_expr;
1896    memset(&h_expr,0,sizeof(h_expr));
1897    h_expr.rtyp=IDHDL;
1898    h_expr.data=h;
1899    h_expr.name=vn;
1900    return iiAssign(&tmp_expr,&h_expr);
1901  }
1902  else
1903  {
1904    Werror("`%s` not found in `%s`",v->Name(), u->Name());
1905    return TRUE;
1906  }
1907  return FALSE;
1908}
Note: See TracBrowser for help on using the repository browser.