source: git/Singular/ipassign.cc @ ba5e9e

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