source: git/Singular/ipassign.cc @ 772990

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