source: git/Singular/ipassign.cc @ 16f511

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