source: git/Singular/ipassign.cc @ 108e2ec

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