source: git/Singular/ipassign.cc @ 8ca38a7

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