source: git/Singular/ipassign.cc @ 528f5b7

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