source: git/Singular/ipassign.cc @ 7447d8

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