source: git/Singular/ipassign.cc @ 542685e

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