source: git/Singular/ipassign.cc @ 021751

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