source: git/Singular/ipassign.cc @ 993ae2

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