source: git/Singular/ipassign.cc @ 1cd0f4

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