source: git/Singular/ipassign.cc @ f5d2647

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