source: git/Singular/ipassign.cc @ 81c5cb

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