source: git/Singular/ipassign.cc @ 47719a

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