source: git/Singular/ipassign.cc @ 5d51cc6

spielwiese
Last change on this file since 5d51cc6 was 2f6b7cb, checked in by Hans Schoenemann <hannes@…>, 8 years ago
chg: redefine warning only if option(redefine)
  • Property mode set to 100644
File size: 50.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: interpreter:
6*           assignment of expressions and lists to objects or lists
7*/
8
9#include <stdlib.h>
10#include <string.h>
11#include <ctype.h>
12
13
14#include <kernel/mod2.h>
15
16#include <omalloc/omalloc.h>
17
18#define TRANSEXT_PRIVATES
19#include <polys/ext_fields/transext.h>
20
21#include <misc/options.h>
22#include <misc/intvec.h>
23
24#include <coeffs/coeffs.h>
25#include <coeffs/numbers.h>
26#include <coeffs/bigintmat.h>
27
28
29#include <polys/ext_fields/algext.h>
30
31#include <polys/monomials/ring.h>
32#include <polys/matpol.h>
33#include <polys/monomials/maps.h>
34#include <polys/nc/nc.h>
35#include <polys/nc/sca.h>
36#include <polys/prCopy.h>
37
38#include <kernel/polys.h>
39#include <kernel/ideals.h>
40#include <kernel/GBEngine/kstd1.h>
41#include <kernel/oswrapper/timer.h>
42#include <kernel/combinatorics/stairc.h>
43#include <kernel/GBEngine/syz.h>
44
45//#include "weight.h"
46#include "tok.h"
47#include "ipid.h"
48#include "idrec.h"
49#include "subexpr.h"
50#include "lists.h"
51#include "ipconv.h"
52#include "attrib.h"
53#include "links/silink.h"
54#include "ipshell.h"
55#include "blackbox.h"
56#include "Singular/number2.h"
57
58/*=================== proc =================*/
59static BOOLEAN jjECHO(leftv, leftv a)
60{
61  si_echo=(int)((long)(a->Data()));
62  return FALSE;
63}
64static BOOLEAN jjPRINTLEVEL(leftv, leftv a)
65{
66  printlevel=(int)((long)(a->Data()));
67  return FALSE;
68}
69static BOOLEAN jjCOLMAX(leftv, leftv a)
70{
71  colmax=(int)((long)(a->Data()));
72  return FALSE;
73}
74static BOOLEAN jjTIMER(leftv, leftv a)
75{
76  timerv=(int)((long)(a->Data()));
77  initTimer();
78  return FALSE;
79}
80#ifdef HAVE_GETTIMEOFDAY
81static BOOLEAN jjRTIMER(leftv, leftv a)
82{
83  rtimerv=(int)((long)(a->Data()));
84  initRTimer();
85  return FALSE;
86}
87#endif
88static BOOLEAN jjMAXDEG(leftv, leftv a)
89{
90  Kstd1_deg=(int)((long)(a->Data()));
91  if (Kstd1_deg!=0)
92    si_opt_1 |=Sy_bit(OPT_DEGBOUND);
93  else
94    si_opt_1 &=(~Sy_bit(OPT_DEGBOUND));
95  return FALSE;
96}
97static BOOLEAN jjMAXMULT(leftv, leftv a)
98{
99  Kstd1_mu=(int)((long)(a->Data()));
100  if (Kstd1_mu!=0)
101    si_opt_1 |=Sy_bit(OPT_MULTBOUND);
102  else
103    si_opt_1 &=(~Sy_bit(OPT_MULTBOUND));
104  return FALSE;
105}
106static BOOLEAN jjTRACE(leftv, leftv a)
107{
108  traceit=(int)((long)(a->Data()));
109  return FALSE;
110}
111static BOOLEAN jjSHORTOUT(leftv, leftv a)
112{
113  if (currRing != NULL)
114  {
115    BOOLEAN shortOut = (BOOLEAN)((long)a->Data());
116#if HAVE_CAN_SHORT_OUT
117    if (!shortOut)
118      currRing->ShortOut = 0;
119    else
120    {
121      if (currRing->CanShortOut)
122        currRing->ShortOut = 1;
123    }
124#else
125    currRing->ShortOut = shortOut;
126    coeffs cf = currRing->cf;
127    while (nCoeff_is_Extension(cf)) {
128      cf->extRing->ShortOut = shortOut;
129      assume(cf->extRing != NULL);
130      cf = cf->extRing->cf;
131    }
132#endif
133  }
134  return FALSE;
135}
136static void jjMINPOLY_red(idhdl h)
137{
138  switch(IDTYP(h))
139  {
140    case NUMBER_CMD:
141    {
142      number n=(number)IDDATA(h);
143      number one = nInit(1);
144      number nn=nMult(n,one);
145      nDelete(&n);nDelete(&one);
146      IDDATA(h)=(char*)nn;
147      break;
148    }
149    case VECTOR_CMD:
150    case POLY_CMD:
151    {
152      poly p=(poly)IDDATA(h);
153      IDDATA(h)=(char*)p_MinPolyNormalize(p, currRing);
154      break;
155    }
156    case IDEAL_CMD:
157    case MODUL_CMD:
158    case MAP_CMD:
159    case MATRIX_CMD:
160    {
161      int i;
162      ideal I=(ideal)IDDATA(h);
163      for(i=IDELEMS(I)-1;i>=0;i--)
164             I->m[i]=p_MinPolyNormalize(I->m[i], currRing);
165      break;
166    }
167    case LIST_CMD:
168    {
169      lists L=(lists)IDDATA(h);
170      int i=L->nr;
171      for(;i>=0;i--)
172      {
173        jjMINPOLY_red((idhdl)&(L->m[i]));
174      }
175    }
176    default:
177    //case RESOLUTION_CMD:
178       Werror("type %d too complex...set minpoly before",IDTYP(h)); break;
179  }
180}
181static BOOLEAN jjMINPOLY(leftv, leftv a)
182{
183  if( !nCoeff_is_transExt(currRing->cf) && (currRing->idroot == NULL) && n_IsZero((number)a->Data(), currRing->cf) )
184  {
185#ifndef SING_NDEBUG
186    WarnS("Set minpoly over non-transcendental ground field to 0?!");
187    Warn("in >>%s<<",my_yylinebuf);
188#endif
189    return FALSE;
190  }
191
192
193  if ( !nCoeff_is_transExt(currRing->cf) )
194  {
195    WarnS("Trying to set minpoly over non-transcendental ground field...");
196    if(!nCoeff_is_algExt(currRing->cf) )
197    {
198      WerrorS("cannot set minpoly for these coeffients");
199      return TRUE;
200    }
201  }
202  if ((rVar(currRing->cf->extRing)!=1)
203  && !n_IsZero((number)a->Data(), currRing->cf) )
204  {
205    WerrorS("only univarite minpoly allowed");
206    return TRUE;
207  }
208
209  if ( currRing->idroot != NULL )
210  {
211//    return TRUE;
212#ifndef SING_NDEBUG
213    idhdl p = currRing->idroot;
214
215    WarnS("no minpoly allowed if there are local objects belonging to the basering: ");
216
217    while(p != NULL)
218    {
219      PrintS(p->String(TRUE)); PrintLn();
220      p = p->next;
221    }
222#endif
223  }
224
225//  assume (currRing->idroot==NULL);
226
227  number p = (number)a->CopyD(NUMBER_CMD);
228  n_Normalize(p, currRing->cf);
229
230  if (n_IsZero(p, currRing->cf))
231  {
232    n_Delete(&p, currRing->cf);
233    if( nCoeff_is_transExt(currRing->cf) )
234    {
235#ifndef SING_NDEBUG
236      WarnS("minpoly is already 0...");
237#endif
238      return FALSE;
239    }
240    WarnS("cannot set minpoly to 0 / alg. extension?");
241    return TRUE;
242  }
243
244  // remove all object currently in the ring
245  while(currRing->idroot!=NULL)
246  {
247#ifndef SING_NDEBUG
248    Warn("killing a local object due to minpoly change: %s", IDID(currRing->idroot));
249#endif
250    killhdl2(currRing->idroot,&(currRing->idroot),currRing);
251  }
252
253  AlgExtInfo A;
254
255  A.r = rCopy(currRing->cf->extRing); // Copy  ground field!
256  // if minpoly was already set:
257  if( currRing->cf->extRing->qideal != NULL ) id_Delete(&(A.r->qideal),A.r);
258  ideal q = idInit(1,1);
259  if ((p==NULL) ||(NUM((fraction)p)==NULL))
260  {
261    WerrorS("Could not construct the alg. extension: minpoly==0");
262    // cleanup A: TODO
263    rDelete( A.r );
264    return TRUE;
265  }
266  if (DEN((fraction)(p)) != NULL) // minpoly must be a fraction with poly numerator...!!
267  {
268    poly z=NUM((fraction)p);
269    poly n=DEN((fraction)(p));
270    z=p_Mult_nn(z,pGetCoeff(n),currRing->cf->extRing);
271    NUM((fraction)p)=z;
272    DEN((fraction)(p))=NULL;
273    p_Delete(&n,currRing->cf->extRing);
274  }
275
276  q->m[0] = NUM((fraction)p);
277  A.r->qideal = q;
278
279#if 0
280  PrintS("\nTrying to conver the currRing into an algebraic field: ");
281  PrintS("Ground poly. ring: \n");
282  rWrite( A.r );
283  PrintS("\nGiven MinPOLY: ");
284  p_Write( A.i->m[0], A.r );
285#endif
286
287  // :(
288//  NUM((fractionObject *)p) = NULL; // makes 0/ NULL fraction - which should not happen!
289//  n_Delete(&p, currRing->cf); // doesn't expect 0/ NULL :(
290  if(true)
291  {
292    extern omBin fractionObjectBin;
293    NUM((fractionObject *)p) = NULL; // not necessary, but still...
294    omFreeBin((ADDRESS)p, fractionObjectBin);
295  }
296
297
298  coeffs new_cf = nInitChar(n_algExt, &A);
299
300  if (new_cf==NULL)
301  {
302    WerrorS("Could not construct the alg. extension: llegal minpoly?");
303    // cleanup A: TODO
304    rDelete( A.r );
305    return TRUE;
306  }
307  else
308  {
309    nKillChar(currRing->cf); currRing->cf=new_cf;
310  }
311
312  return FALSE;
313}
314static BOOLEAN jjNOETHER(leftv, leftv a)
315{
316  poly p=(poly)a->CopyD(POLY_CMD);
317  pDelete(&(currRing->ppNoether));
318  (currRing->ppNoether)=p;
319  return FALSE;
320}
321/*=================== proc =================*/
322static void jiAssignAttr(leftv l,leftv r)
323{
324  // get the attribute of th right side
325  // and set it to l
326  leftv rv=r->LData();
327  if (rv!=NULL)
328  {
329    if (rv->e==NULL)
330    {
331      if (rv->attribute!=NULL)
332      {
333        attr la;
334        if (r->rtyp!=IDHDL)
335        {
336          la=rv->attribute;
337          rv->attribute=NULL;
338        }
339        else
340        {
341          la=rv->attribute->Copy();
342        }
343        l->attribute=la;
344      }
345      l->flag=rv->flag;
346    }
347  }
348  if (l->rtyp==IDHDL)
349  {
350    idhdl h=(idhdl)l->data;
351    IDATTR(h)=l->attribute;
352    IDFLAG(h)=l->flag;
353  }
354}
355static BOOLEAN jiA_INT(leftv res, leftv a, Subexpr e)
356{
357  if (e==NULL)
358  {
359    res->data=(void *)a->Data();
360    jiAssignAttr(res,a);
361  }
362  else
363  {
364    int i=e->start-1;
365    if (i<0)
366    {
367      Werror("index[%d] must be positive",i+1);
368      return TRUE;
369    }
370    intvec *iv=(intvec *)res->data;
371    if (e->next==NULL)
372    {
373      if (i>=iv->length())
374      {
375        intvec *iv1=new intvec(i+1);
376        (*iv1)[i]=(int)((long)(a->Data()));
377        intvec *ivn=ivAdd(iv,iv1);
378        delete iv;
379        delete iv1;
380        res->data=(void *)ivn;
381      }
382      else
383        (*iv)[i]=(int)((long)(a->Data()));
384    }
385    else
386    {
387      int c=e->next->start;
388      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
389      {
390        Werror("wrong range [%d,%d] in intmat %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
391        return TRUE;
392      }
393      else
394        IMATELEM(*iv,i+1,c) = (int)((long)(a->Data()));
395    }
396  }
397  return FALSE;
398}
399static BOOLEAN jiA_NUMBER(leftv res, leftv a, Subexpr)
400{
401  number p=(number)a->CopyD(NUMBER_CMD);
402  if (res->data!=NULL) nDelete((number *)&res->data);
403  nNormalize(p);
404  res->data=(void *)p;
405  jiAssignAttr(res,a);
406  return FALSE;
407}
408#ifdef SINGULAR_4_1
409static BOOLEAN jiA_NUMBER2(leftv res, leftv a, Subexpr e)
410{
411  number2 n=(number2)a->CopyD(CNUMBER_CMD);
412  if (e==NULL)
413  {
414    if (res->data!=NULL)
415    {
416      number2 nn=(number2)res->data;
417      n2Delete(nn);
418    }
419    res->data=(void *)n;
420    jiAssignAttr(res,a);
421  }
422  else
423  {
424    int i=e->start-1;
425    if (i<0)
426    {
427      Werror("index[%d] must be positive",i+1);
428      return TRUE;
429    }
430    bigintmat *iv=(bigintmat *)res->data;
431    if (e->next==NULL)
432    {
433      WerrorS("only one index given");
434      return TRUE;
435    }
436    else
437    {
438      int c=e->next->start;
439      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
440      {
441        Werror("wrong range [%d,%d] in cmatrix %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
442        return TRUE;
443      }
444      else if (iv->basecoeffs()==n->cf)
445      {
446        n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
447        BIMATELEM(*iv,i+1,c) = n->n;
448      }
449      else
450      {
451        WerrorS("different base");
452        return TRUE;
453      }
454    }
455  }
456  jiAssignAttr(res,a);
457  return FALSE;
458}
459static BOOLEAN jiA_NUMBER2_I(leftv res, leftv a, Subexpr e)
460{
461  if (e==NULL)
462  {
463    if (res->data!=NULL)
464    {
465      number2 nn=(number2)res->data;
466      number2 n=n2Init((long)a->Data(),nn->cf);
467      n2Delete(nn);
468      res->data=(void *)n;
469    }
470    else
471    {
472      WerrorS("no Ring avialable for conversion from int");
473      return TRUE;
474    }
475  }
476  else
477  {
478    int i=e->start-1;
479    if (i<0)
480    {
481      Werror("index[%d] must be positive",i+1);
482      return TRUE;
483    }
484    bigintmat *iv=(bigintmat *)res->data;
485    if (e->next==NULL)
486    {
487      WerrorS("only one index given");
488      return TRUE;
489    }
490    else
491    {
492      int c=e->next->start;
493      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
494      {
495        Werror("wrong range [%d,%d] in cmatrix %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
496        return TRUE;
497      }
498      else
499      {
500        n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
501        BIMATELEM(*iv,i+1,c) = n_Init((long)a->Data(),iv->basecoeffs());
502      }
503    }
504  }
505  return FALSE;
506}
507static BOOLEAN jiA_NUMBER2_N(leftv res, leftv a, Subexpr e)
508{
509  if (e==NULL)
510  {
511    if (res->data!=NULL)
512    {
513      number2 nn=(number2)res->data;
514      number2 n=(number2)omAlloc(sizeof(*n));
515      n->cf=currRing->cf; n->cf->ref++;
516      n->n=(number)a->CopyD(NUMBER_CMD);
517      n2Delete(nn);
518      res->data=(void *)n;
519    }
520    else
521    {
522      number2 n=(number2)omAlloc(sizeof(*n));
523      n->cf=currRing->cf; n->cf->ref++;
524      n->n=(number)a->CopyD(NUMBER_CMD);
525      res->data=(void *)n;
526    }
527  }
528  else return TRUE; // TODO: list elements
529  return FALSE;
530}
531static BOOLEAN jiA_POLY2(leftv res, leftv a, Subexpr e)
532{
533  poly2 n=(poly2)a->CopyD(CPOLY_CMD);
534  if (e==NULL)
535  {
536    if (res->data!=NULL)
537    {
538      poly2 nn=(poly2)res->data;
539      p2Delete(nn);
540    }
541    res->data=(void *)n;
542    jiAssignAttr(res,a);
543  }
544  else
545  {
546    int i=e->start-1;
547    if (i<0)
548    {
549      Werror("index[%d] must be positive",i+1);
550      return TRUE;
551    }
552    WerrorS("not yet"); // TODO: list elem
553    return TRUE;
554  }
555  jiAssignAttr(res,a);
556  return FALSE;
557}
558static BOOLEAN jiA_POLY2_P(leftv res, leftv a, Subexpr e)
559{
560  if (e==NULL)
561  {
562    if (res->data!=NULL)
563    {
564      poly2 nn=(poly2)res->data;
565      poly2 n=(poly2)omAlloc(sizeof(*n));
566      n->cf=currRing; n->cf->ref++;
567      n->n=(poly)a->CopyD(POLY_CMD);
568      p2Delete(nn);
569      res->data=(void *)n;
570    }
571    else
572    {
573      poly2 n=(poly2)omAlloc(sizeof(*n));
574      n->cf=currRing; n->cf->ref++;
575      n->n=(poly)a->CopyD(POLY_CMD);
576      res->data=(void *)n;
577    }
578  }
579  else return TRUE; // TODO: list elements
580  return FALSE;
581}
582#endif
583static BOOLEAN jiA_BIGINT(leftv res, leftv a, Subexpr e)
584{
585  number p=(number)a->CopyD(BIGINT_CMD);
586  if (e==NULL)
587  {
588    if (res->data!=NULL) n_Delete((number *)&res->data,coeffs_BIGINT);
589    res->data=(void *)p;
590  }
591  else
592  {
593    int i=e->start-1;
594    if (i<0)
595    {
596      Werror("index[%d] must be positive",i+1);
597      return TRUE;
598    }
599    bigintmat *iv=(bigintmat *)res->data;
600    if (e->next==NULL)
601    {
602      WerrorS("only one index given");
603      return TRUE;
604    }
605    else
606    {
607      int c=e->next->start;
608      if ((i>=iv->rows())||(c<1)||(c>iv->cols()))
609      {
610        Werror("wrong range [%d,%d] in bigintmat %s(%d,%d)",i+1,c,res->Name(),iv->rows(),iv->cols());
611        return TRUE;
612      }
613      else
614      {
615        n_Delete((number *)&BIMATELEM(*iv,i+1,c),iv->basecoeffs());
616        BIMATELEM(*iv,i+1,c) = p;
617      }
618    }
619  }
620  jiAssignAttr(res,a);
621  return FALSE;
622}
623static BOOLEAN jiA_LIST_RES(leftv res, leftv a,Subexpr)
624{
625  syStrategy r=(syStrategy)a->CopyD(RESOLUTION_CMD);
626  if (res->data!=NULL) ((lists)res->data)->Clean();
627  int add_row_shift = 0;
628  intvec *weights=(intvec*)atGet(a,"isHomog",INTVEC_CMD);
629  if (weights!=NULL)  add_row_shift=weights->min_in();
630  res->data=(void *)syConvRes(r,TRUE,add_row_shift);
631  //jiAssignAttr(res,a);
632  return FALSE;
633}
634static BOOLEAN jiA_LIST(leftv res, leftv a,Subexpr)
635{
636  lists l=(lists)a->CopyD(LIST_CMD);
637  if (res->data!=NULL) ((lists)res->data)->Clean();
638  res->data=(void *)l;
639  jiAssignAttr(res,a);
640  return FALSE;
641}
642static BOOLEAN jiA_POLY(leftv res, leftv a,Subexpr e)
643{
644  poly p=(poly)a->CopyD(POLY_CMD);
645  pNormalize(p);
646  if (e==NULL)
647  {
648    if ((p!=NULL) && TEST_V_QRING && (currRing->qideal!=NULL)
649    && (!hasFlag(a,FLAG_QRING)))
650    {
651      jjNormalizeQRingP(p);
652      setFlag(res,FLAG_QRING);
653    }
654    if (res->data!=NULL) pDelete((poly*)&res->data);
655    res->data=(void*)p;
656    jiAssignAttr(res,a);
657  }
658  else
659  {
660    int i,j;
661    matrix m=(matrix)res->data;
662    i=e->start;
663    if (e->next==NULL)
664    {
665      j=i; i=1;
666      // for all ideal like data types: check indices
667      if (j>MATCOLS(m))
668      {
669        if (TEST_V_ALLWARN)
670        {
671          Warn("increase ideal %d -> %d in %s",MATCOLS(m),j,my_yylinebuf);
672        }
673        pEnlargeSet(&(m->m),MATCOLS(m),j-MATCOLS(m));
674        MATCOLS(m)=j;
675      }
676      else if (j<=0)
677      {
678        Werror("index[%d] must be positive",j/*e->start*/);
679        return TRUE;
680      }
681    }
682    else
683    {
684      // for matrices: indices are correct (see ipExprArith3(..,'['..) )
685      j=e->next->start;
686    }
687    if ((p!=NULL) && TEST_V_QRING && (currRing->qideal!=NULL))
688    {
689      jjNormalizeQRingP(p);
690    }
691    pDelete(&MATELEM(m,i,j));
692    MATELEM(m,i,j)=p;
693    /* for module: update rank */
694    if ((p!=NULL) && (pGetComp(p)!=0))
695    {
696      m->rank=si_max(m->rank,pMaxComp(p));
697    }
698  }
699  return FALSE;
700}
701static BOOLEAN jiA_1x1INTMAT(leftv res, leftv a,Subexpr e)
702{
703  if (/*(*/ res->rtyp!=INTMAT_CMD /*)*/) /*|| (e!=NULL) - TRUE because of type int */
704  {
705    // no error message: assignment simply fails
706    return TRUE;
707  }
708  intvec* am=(intvec*)a->CopyD(INTMAT_CMD);
709  if ((am->rows()!=1) || (am->cols()!=1))
710  {
711    WerrorS("must be 1x1 intmat");
712    delete am;
713    return TRUE;
714  }
715  intvec* m=(intvec *)res->data;
716  // indices are correct (see ipExprArith3(..,'['..) )
717  int i=e->start;
718  int j=e->next->start;
719  IMATELEM(*m,i,j)=IMATELEM(*am,1,1);
720  delete am;
721  return FALSE;
722}
723static BOOLEAN jiA_1x1MATRIX(leftv res, leftv a,Subexpr e)
724{
725  if (/*(*/ res->rtyp!=MATRIX_CMD /*)*/) /*|| (e!=NULL) - TRUE because of type poly */
726  {
727    // no error message: assignment simply fails
728    return TRUE;
729  }
730  matrix am=(matrix)a->CopyD(MATRIX_CMD);
731  if ((MATROWS(am)!=1) || (MATCOLS(am)!=1))
732  {
733    WerrorS("must be 1x1 matrix");
734    idDelete((ideal *)&am);
735    return TRUE;
736  }
737  matrix m=(matrix)res->data;
738  // indices are correct (see ipExprArith3(..,'['..) )
739  int i=e->start;
740  int j=e->next->start;
741  pDelete(&MATELEM(m,i,j));
742  pNormalize(MATELEM(am,1,1));
743  MATELEM(m,i,j)=MATELEM(am,1,1);
744  MATELEM(am,1,1)=NULL;
745  idDelete((ideal *)&am);
746  return FALSE;
747}
748static BOOLEAN jiA_STRING(leftv res, leftv a, Subexpr e)
749{
750  if (e==NULL)
751  {
752    void* tmp = res->data;
753    res->data=(void *)a->CopyD(STRING_CMD);
754    jiAssignAttr(res,a);
755    omfree(tmp);
756  }
757  else
758  {
759    char *s=(char *)res->data;
760    if ((e->start>0)&&(e->start<=(int)strlen(s)))
761      s[e->start-1]=(char)(*((char *)a->Data()));
762    else
763    {
764      Werror("string index %d out of range 1..%d",e->start,(int)strlen(s));
765      return TRUE;
766    }
767  }
768  return FALSE;
769}
770static BOOLEAN jiA_PROC(leftv res, leftv a, Subexpr)
771{
772  extern procinfo *iiInitSingularProcinfo(procinfo *pi, const char *libname,
773                                          const char *procname, int line,
774                                          long pos, BOOLEAN pstatic=FALSE);
775  if(res->data!=NULL) piKill((procinfo *)res->data);
776  if(a->Typ()==STRING_CMD)
777  {
778    res->data = (void *)omAlloc0Bin(procinfo_bin);
779    ((procinfo *)(res->data))->language=LANG_NONE;
780    iiInitSingularProcinfo((procinfo *)res->data,"",res->name,0,0);
781    ((procinfo *)res->data)->data.s.body=(char *)a->CopyD(STRING_CMD);
782  }
783  else
784    res->data=(void *)a->CopyD(PROC_CMD);
785  jiAssignAttr(res,a);
786  return FALSE;
787}
788static BOOLEAN jiA_INTVEC(leftv res, leftv a, Subexpr)
789{
790  //if ((res->data==NULL) || (res->Typ()==a->Typ()))
791  {
792    if (res->data!=NULL) delete ((intvec *)res->data);
793    res->data=(void *)a->CopyD(INTVEC_CMD);
794    jiAssignAttr(res,a);
795    return FALSE;
796  }
797#if 0
798  else
799  {
800    intvec *r=(intvec *)(res->data);
801    intvec *s=(intvec *)(a->Data());
802    int i=si_min(r->length(), s->length())-1;
803    for(;i>=0;i--)
804    {
805      (*r)[i]=(*s)[i];
806    }
807    return FALSE; //(r->length()< s->length());
808  }
809#endif
810}
811static BOOLEAN jiA_BIGINTMAT(leftv res, leftv a, Subexpr)
812{
813  if (res->data!=NULL) delete ((bigintmat *)res->data);
814  res->data=(void *)a->CopyD(BIGINTMAT_CMD);
815  jiAssignAttr(res,a);
816  return FALSE;
817}
818static BOOLEAN jiA_IDEAL(leftv res, leftv a, Subexpr)
819{
820  if (res->data!=NULL) idDelete((ideal*)&res->data);
821  res->data=(void *)a->CopyD(MATRIX_CMD);
822  if (a->rtyp==IDHDL) id_Normalize((ideal)a->Data(), currRing);
823  else                id_Normalize((ideal)res->data, currRing);
824  jiAssignAttr(res,a);
825  if (((res->rtyp==IDEAL_CMD)||(res->rtyp==MODUL_CMD))
826  && (IDELEMS((ideal)(res->data))==1)
827  && (currRing->qideal==NULL)
828  && (!rIsPluralRing(currRing))
829  )
830  {
831    setFlag(res,FLAG_STD);
832  }
833  if (TEST_V_QRING && (currRing->qideal!=NULL)&& (!hasFlag(res,FLAG_QRING))) jjNormalizeQRingId(res);
834  return FALSE;
835}
836static BOOLEAN jiA_RESOLUTION(leftv res, leftv a, Subexpr)
837{
838  if (res->data!=NULL) syKillComputation((syStrategy)res->data);
839  res->data=(void *)a->CopyD(RESOLUTION_CMD);
840  jiAssignAttr(res,a);
841  return FALSE;
842}
843static BOOLEAN jiA_MODUL_P(leftv res, leftv a, Subexpr)
844/* module = poly */
845{
846  if (res->data!=NULL) idDelete((ideal*)&res->data);
847  ideal I=idInit(1,1);
848  I->m[0]=(poly)a->CopyD(POLY_CMD);
849  if (I->m[0]!=NULL) pSetCompP(I->m[0],1);
850  pNormalize(I->m[0]);
851  res->data=(void *)I;
852  if (TEST_V_QRING && (currRing->qideal!=NULL))
853  {
854    if (hasFlag(a,FLAG_QRING)) setFlag(res,FLAG_QRING);
855    else                       jjNormalizeQRingId(res);
856  }
857  return FALSE;
858}
859static BOOLEAN jiA_IDEAL_M(leftv res, leftv a, Subexpr)
860{
861  if (res->data!=NULL) idDelete((ideal*)&res->data);
862  matrix m=(matrix)a->CopyD(MATRIX_CMD);
863  if (TEST_V_ALLWARN)
864    if (MATROWS(m)>1)
865      Warn("assign matrix with %d rows to an ideal in >>%s<<",MATROWS(m),my_yylinebuf);
866  IDELEMS((ideal)m)=MATROWS(m)*MATCOLS(m);
867  ((ideal)m)->rank=1;
868  MATROWS(m)=1;
869  id_Normalize((ideal)m, currRing);
870  res->data=(void *)m;
871  if (TEST_V_QRING && (currRing->qideal!=NULL)) jjNormalizeQRingId(res);
872  return FALSE;
873}
874static BOOLEAN jiA_LINK(leftv res, leftv a, Subexpr)
875{
876  si_link l=(si_link)res->data;
877
878  if (l!=NULL) slCleanUp(l);
879
880  if (a->Typ() == STRING_CMD)
881  {
882    if (l == NULL)
883    {
884      l = (si_link) omAlloc0Bin(sip_link_bin);
885      res->data = (void *) l;
886    }
887    return slInit(l, (char *) a->Data());
888  }
889  else if (a->Typ() == LINK_CMD)
890  {
891    if (l != NULL) omFreeBin(l, sip_link_bin);
892    res->data = slCopy((si_link)a->Data());
893    return FALSE;
894  }
895  return TRUE;
896}
897// assign map -> map
898static BOOLEAN jiA_MAP(leftv res, leftv a, Subexpr)
899{
900  if (res->data!=NULL)
901  {
902    omFree((ADDRESS)((map)res->data)->preimage);
903    ((map)res->data)->preimage=NULL;
904    idDelete((ideal*)&res->data);
905  }
906  res->data=(void *)a->CopyD(MAP_CMD);
907  jiAssignAttr(res,a);
908  return FALSE;
909}
910// assign ideal -> map
911static BOOLEAN jiA_MAP_ID(leftv res, leftv a, Subexpr)
912{
913  map f=(map)res->data;
914  char *rn=f->preimage; // save the old/already assigned preimage ring name
915  f->preimage=NULL;
916  idDelete((ideal *)&f);
917  res->data=(void *)a->CopyD(IDEAL_CMD);
918  f=(map)res->data;
919  id_Normalize((ideal)f, currRing);
920  f->preimage = rn;
921  return FALSE;
922}
923static BOOLEAN jiA_QRING(leftv res, leftv a,Subexpr e)
924{
925  // the follwing can only happen, if:
926  //   - the left side is of type qring AND not an id
927  if ((e!=NULL)||(res->rtyp!=IDHDL))
928  {
929    WerrorS("qring_id expected");
930    return TRUE;
931  }
932  ring old_ring=(ring)res->Data();
933
934  coeffs newcf = currRing->cf;
935  ideal id = (ideal)a->Data(); //?
936  const int cpos = idPosConstant(id);
937  if(rField_is_Ring(currRing))
938    if (cpos >= 0)
939    {
940        newcf = n_CoeffRingQuot1(p_GetCoeff(id->m[cpos], currRing), currRing->cf);
941        if(newcf == NULL)
942          return TRUE;
943    }
944  //qr=(ring)res->Data();
945  //if (qr!=NULL) omFreeBin((ADDRESS)qr, ip_sring_bin);
946  ring qr = rCopy(currRing);
947  assume(qr->cf == currRing->cf);
948
949  if ( qr->cf != newcf )
950  {
951    nKillChar ( qr->cf ); // ???
952    qr->cf = newcf;
953  }
954                 // we have to fill it, but the copy also allocates space
955  idhdl h=(idhdl)res->data; // we have res->rtyp==IDHDL
956  IDRING(h)=qr;
957
958  ideal qid;
959
960  if((rField_is_Ring(currRing)) && (cpos != -1))
961  {
962    int i, j;
963    int *perm = (int *)omAlloc0((qr->N+1)*sizeof(int));
964
965    for(i=qr->N;i>0;i--)
966      perm[i]=i;
967
968    nMapFunc nMap = n_SetMap(currRing->cf, newcf);
969    qid = idInit(IDELEMS(id)-1,1);
970    for(i = 0, j = 0; i<IDELEMS(id); i++)
971      if( i != cpos )
972        qid->m[j++] = p_PermPoly(id->m[i], perm, currRing, qr, nMap, NULL, 0);
973  }
974  else
975    qid = idrCopyR(id,currRing,qr);
976
977  idSkipZeroes(qid);
978  //idPrint(qid);
979  if ((idElem(qid)>1) || rIsSCA(currRing) || (currRing->qideal!=NULL))
980    assumeStdFlag(a);
981
982  if (currRing->qideal!=NULL) /* we are already in a qring! */
983  {
984    ideal tmp=idSimpleAdd(qid,currRing->qideal);
985    // both ideals should be GB, so dSimpleAdd is sufficient
986    idDelete(&qid);
987    qid=tmp;
988    // delete the qr copy of quotient ideal!!!
989    idDelete(&qr->qideal);
990  }
991  if (idElem(qid)==0)
992  {
993    qr->qideal = NULL;
994    id_Delete(&qid,currRing);
995    IDTYP(h)=RING_CMD;
996  }
997  else
998    qr->qideal = qid;
999
1000  // qr is a copy of currRing with the new qideal!
1001  #ifdef HAVE_PLURAL
1002  if(rIsPluralRing(currRing) &&(qr->qideal!=NULL))
1003  {
1004    if (!hasFlag(a,FLAG_TWOSTD))
1005    {
1006      Warn("%s is no twosided standard basis",a->Name());
1007    }
1008
1009    if( nc_SetupQuotient(qr, currRing) )
1010    {
1011//      WarnS("error in nc_SetupQuotient");
1012    }
1013  }
1014  #endif
1015  //rWrite(qr);
1016  rSetHdl((idhdl)res->data);
1017  if (old_ring!=NULL)
1018  {
1019    rDelete(old_ring);
1020  }
1021  return FALSE;
1022}
1023
1024static BOOLEAN jiA_RING(leftv res, leftv a, Subexpr e)
1025{
1026  BOOLEAN have_id=TRUE;
1027  if ((e!=NULL)||(res->rtyp!=IDHDL))
1028  {
1029    //WerrorS("id expected");
1030    //return TRUE;
1031    have_id=FALSE;
1032  }
1033  ring r=(ring)a->Data();
1034  if ((r==NULL)||(r->cf==NULL)) return TRUE;
1035  if (have_id)
1036  {
1037    idhdl rl=(idhdl)res->data;
1038    if (IDRING(rl)!=NULL) rKill(rl);
1039    IDRING(rl)=r;
1040    if ((IDLEV((idhdl)a->data)!=myynest) && (r==currRing))
1041      currRingHdl=(idhdl)res->data;
1042  }
1043  else
1044  {
1045    if (e==NULL) res->data=(char *)r;
1046    else
1047    {
1048      WerrorS("id expected");
1049      return TRUE;
1050    }
1051  }
1052  r->ref++;
1053  jiAssignAttr(res,a);
1054  return FALSE;
1055}
1056static BOOLEAN jiA_PACKAGE(leftv res, leftv a, Subexpr)
1057{
1058  res->data=(void *)a->CopyD(PACKAGE_CMD);
1059  jiAssignAttr(res,a);
1060  return FALSE;
1061}
1062static BOOLEAN jiA_DEF(leftv res, leftv, Subexpr)
1063{
1064  res->data=(void *)0;
1065  return FALSE;
1066}
1067#ifdef SINGULAR_4_1
1068static BOOLEAN jiA_CRING(leftv res, leftv a, Subexpr e)
1069{
1070  res->data=(void *)a->CopyD(CRING_CMD);
1071  jiAssignAttr(res,a);
1072  return FALSE;
1073}
1074#endif
1075
1076/*=================== table =================*/
1077#define IPASSIGN
1078#define D(A)     A
1079#define NULL_VAL NULL
1080#include "table.h"
1081/*=================== operations ============================*/
1082/*2
1083* assign a = b
1084*/
1085static BOOLEAN jiAssign_1(leftv l, leftv r, BOOLEAN toplevel)
1086{
1087  int rt=r->Typ();
1088  if (rt==0)
1089  {
1090    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
1091    return TRUE;
1092  }
1093
1094  int lt=l->Typ();
1095  if (lt==0)
1096  {
1097    if (!errorreported) Werror("left side `%s` is undefined",l->Fullname());
1098    return TRUE;
1099  }
1100  if(rt==NONE)
1101  {
1102    WarnS("right side is not a datum, assignment ignored");
1103    Warn("in line >>%s<<",my_yylinebuf);
1104    // if (!errorreported)
1105    //   WerrorS("right side is not a datum");
1106    //return TRUE;
1107    return FALSE;
1108  }
1109
1110  if (lt==DEF_CMD)
1111  {
1112    if (TEST_V_ALLWARN
1113    && (rt!=RING_CMD)
1114    && (l->name!=NULL)
1115    && (l->e==NULL)
1116    && (iiCurrArgs==NULL) /* not in proc header */
1117    )
1118    {
1119      Warn("use `%s` instead of `def` in %s:%d:%s",Tok2Cmdname(rt),
1120            currentVoice->filename,yylineno,my_yylinebuf);
1121    }
1122    if (l->rtyp==IDHDL)
1123    {
1124      IDTYP((idhdl)l->data)=rt;
1125    }
1126    else if (l->name!=NULL)
1127    {
1128      sleftv ll;
1129      iiDeclCommand(&ll,l,myynest,rt,&IDROOT);
1130      memcpy(l,&ll,sizeof(sleftv));
1131    }
1132    else
1133    {
1134      l->rtyp=rt;
1135    }
1136    lt=rt;
1137  }
1138  else
1139  {
1140    if ((l->data==r->data)&&(l->e==NULL)&&(r->e==NULL))
1141      return FALSE;
1142  }
1143  leftv ld=l;
1144  if (l->rtyp==IDHDL)
1145  {
1146    if (lt!=RING_CMD)
1147      ld=(leftv)l->data;
1148  }
1149  else if (toplevel)
1150  {
1151    WerrorS("error in assign: left side is not an l-value");
1152    return TRUE;
1153  }
1154  if (lt>MAX_TOK)
1155  {
1156    blackbox *bb=getBlackboxStuff(lt);
1157#ifdef BLACKBOX_DEVEL
1158    Print("bb-assign: bb=%lx\n",bb);
1159#endif
1160    return (bb==NULL) || bb->blackbox_Assign(l,r);
1161  }
1162  int start=0;
1163  while ((dAssign[start].res!=lt)
1164      && (dAssign[start].res!=0)) start++;
1165  int i=start;
1166  while ((dAssign[i].res==lt)
1167      && (dAssign[i].arg!=rt)) i++;
1168  if (dAssign[i].res==lt)
1169  {
1170    if (traceit&TRACE_ASSIGN) Print("assign %s=%s\n",Tok2Cmdname(lt),Tok2Cmdname(rt));
1171    BOOLEAN b;
1172    b=dAssign[i].p(ld,r,l->e);
1173    if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
1174    {
1175      l->flag=ld->flag;
1176      l->attribute=ld->attribute;
1177    }
1178    return b;
1179  }
1180  // implicite type conversion ----------------------------------------------
1181  if (dAssign[i].res!=lt)
1182  {
1183    int ri;
1184    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1185    BOOLEAN failed=FALSE;
1186    i=start;
1187    //while ((dAssign[i].res!=lt)
1188    //  && (dAssign[i].res!=0)) i++;
1189    while (dAssign[i].res==lt)
1190    {
1191      if ((ri=iiTestConvert(rt,dAssign[i].arg))!=0)
1192      {
1193        failed= iiConvert(rt,dAssign[i].arg,ri,r,rn);
1194        if(!failed)
1195        {
1196          failed= dAssign[i].p(ld,rn,l->e);
1197          if (traceit&TRACE_ASSIGN)
1198            Print("assign %s=%s ok? %d\n",Tok2Cmdname(lt),Tok2Cmdname(rn->rtyp),!failed);
1199        }
1200        // everything done, clean up temp. variables
1201        rn->CleanUp();
1202        omFreeBin((ADDRESS)rn, sleftv_bin);
1203        if (failed)
1204        {
1205          // leave loop, goto error handling
1206          break;
1207        }
1208        else
1209        {
1210          if(l!=ld) /* i.e. l is IDHDL, l->data is ld */
1211          {
1212            l->flag=ld->flag;
1213            l->attribute=ld->attribute;
1214          }
1215          // everything ok, return
1216          return FALSE;
1217        }
1218     }
1219     i++;
1220    }
1221    // error handling ---------------------------------------------------
1222    if (!errorreported)
1223    {
1224      if ((l->rtyp==IDHDL) && (l->e==NULL))
1225        Werror("`%s`(%s) = `%s` is not supported",
1226          Tok2Cmdname(lt),l->Name(),Tok2Cmdname(rt));
1227      else
1228         Werror("`%s` = `%s` is not supported"
1229             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1230      if (BVERBOSE(V_SHOW_USE))
1231      {
1232        i=0;
1233        while ((dAssign[i].res!=lt)
1234          && (dAssign[i].res!=0)) i++;
1235        while (dAssign[i].res==lt)
1236        {
1237          Werror("expected `%s` = `%s`"
1238              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign[i].arg));
1239          i++;
1240        }
1241      }
1242    }
1243  }
1244  return TRUE;
1245}
1246/*2
1247* assign sys_var = val
1248*/
1249static BOOLEAN iiAssign_sys(leftv l, leftv r)
1250{
1251  int rt=r->Typ();
1252
1253  if (rt==0)
1254  {
1255    if (!errorreported) Werror("`%s` is undefined",r->Fullname());
1256    return TRUE;
1257  }
1258  int i=0;
1259  int lt=l->rtyp;
1260  while (((dAssign_sys[i].res!=lt)
1261      || (dAssign_sys[i].arg!=rt))
1262    && (dAssign_sys[i].res!=0)) i++;
1263  if (dAssign_sys[i].res!=0)
1264  {
1265    if (!dAssign_sys[i].p(l,r))
1266    {
1267      // everything ok, clean up
1268      return FALSE;
1269    }
1270  }
1271  // implicite type conversion ----------------------------------------------
1272  if (dAssign_sys[i].res==0)
1273  {
1274    int ri;
1275    leftv rn = (leftv)omAlloc0Bin(sleftv_bin);
1276    BOOLEAN failed=FALSE;
1277    i=0;
1278    while ((dAssign_sys[i].res!=lt)
1279      && (dAssign_sys[i].res!=0)) i++;
1280    while (dAssign_sys[i].res==lt)
1281    {
1282      if ((ri=iiTestConvert(rt,dAssign_sys[i].arg))!=0)
1283      {
1284        failed= ((iiConvert(rt,dAssign_sys[i].arg,ri,r,rn))
1285            || (dAssign_sys[i].p(l,rn)));
1286        // everything done, clean up temp. variables
1287        rn->CleanUp();
1288        omFreeBin((ADDRESS)rn, sleftv_bin);
1289        if (failed)
1290        {
1291          // leave loop, goto error handling
1292          break;
1293        }
1294        else
1295        {
1296          // everything ok, return
1297          return FALSE;
1298        }
1299     }
1300     i++;
1301    }
1302    // error handling ---------------------------------------------------
1303    if(!errorreported)
1304    {
1305      Werror("`%s` = `%s` is not supported"
1306             ,Tok2Cmdname(lt),Tok2Cmdname(rt));
1307      if (BVERBOSE(V_SHOW_USE))
1308      {
1309        i=0;
1310        while ((dAssign_sys[i].res!=lt)
1311          && (dAssign_sys[i].res!=0)) i++;
1312        while (dAssign_sys[i].res==lt)
1313        {
1314          Werror("expected `%s` = `%s`"
1315              ,Tok2Cmdname(lt),Tok2Cmdname(dAssign_sys[i].arg));
1316          i++;
1317        }
1318      }
1319    }
1320  }
1321  return TRUE;
1322}
1323static BOOLEAN jiA_INTVEC_L(leftv l,leftv r)
1324{
1325  /* right side is intvec, left side is list (of int)*/
1326  BOOLEAN nok;
1327  int i=0;
1328  leftv l1=l;
1329  leftv h;
1330  sleftv t;
1331  intvec *iv=(intvec *)r->Data();
1332  memset(&t,0,sizeof(sleftv));
1333  t.rtyp=INT_CMD;
1334  while ((i<iv->length())&&(l!=NULL))
1335  {
1336    t.data=(char *)(long)(*iv)[i];
1337    h=l->next;
1338    l->next=NULL;
1339    nok=jiAssign_1(l,&t,TRUE);
1340    l->next=h;
1341    if (nok) return TRUE;
1342    i++;
1343    l=h;
1344  }
1345  l1->CleanUp();
1346  r->CleanUp();
1347  return FALSE;
1348}
1349static BOOLEAN jiA_VECTOR_L(leftv l,leftv r)
1350{
1351  /* right side is vector, left side is list (of poly)*/
1352  BOOLEAN nok;
1353  leftv l1=l;
1354  ideal I=idVec2Ideal((poly)r->Data());
1355  leftv h;
1356  sleftv t;
1357  int i=0;
1358  while (l!=NULL)
1359  {
1360    memset(&t,0,sizeof(sleftv));
1361    t.rtyp=POLY_CMD;
1362    if (i>=IDELEMS(I))
1363    {
1364      t.data=NULL;
1365    }
1366    else
1367    {
1368      t.data=(char *)I->m[i];
1369      I->m[i]=NULL;
1370    }
1371    h=l->next;
1372    l->next=NULL;
1373    nok=jiAssign_1(l,&t,TRUE);
1374    l->next=h;
1375    t.CleanUp();
1376    if (nok)
1377    {
1378      idDelete(&I);
1379      return TRUE;
1380    }
1381    i++;
1382    l=h;
1383  }
1384  idDelete(&I);
1385  l1->CleanUp();
1386  r->CleanUp();
1387  //if (TEST_V_QRING && (currRing->qideal!=NULL)) jjNormalizeQRingP(l);
1388  return FALSE;
1389}
1390static BOOLEAN jjA_L_LIST(leftv l, leftv r)
1391/* left side: list/def, has to be a "real" variable
1392*  right side: expression list
1393*/
1394{
1395  int sl = r->listLength();
1396  lists L=(lists)omAllocBin(slists_bin);
1397  lists oldL;
1398  leftv h=NULL,o_r=r;
1399  int i;
1400  int rt;
1401
1402  L->Init(sl);
1403  for (i=0;i<sl;i++)
1404  {
1405    if (h!=NULL) { /* e.g. not in the first step:
1406                   * h is the pointer to the old sleftv,
1407                   * r is the pointer to the next sleftv
1408                   * (in this moment) */
1409                   h->next=r;
1410                 }
1411    h=r;
1412    r=r->next;
1413    h->next=NULL;
1414    rt=h->Typ();
1415    if ((rt==0)||(rt==NONE)||(rt==DEF_CMD))
1416    {
1417      L->Clean();
1418      Werror("`%s` is undefined",h->Fullname());
1419      //listall();
1420      goto err;
1421    }
1422    //if (rt==RING_CMD)
1423    //{
1424    //  L->m[i].rtyp=rt;
1425    //  L->m[i].data=h->Data();
1426    //  ((ring)L->m[i].data)->ref++;
1427    //}
1428    //else
1429      L->m[i].CleanUp();
1430      L->m[i].Copy(h);
1431      if(errorreported)
1432      {
1433        L->Clean();
1434        goto err;
1435      }
1436  }
1437  oldL=(lists)l->Data();
1438  if (oldL!=NULL) oldL->Clean();
1439  if (l->rtyp==IDHDL)
1440  {
1441    IDLIST((idhdl)l->data)=L;
1442    IDTYP((idhdl)l->data)=LIST_CMD; // was possibly DEF_CMD
1443    if (lRingDependend(L)) ipMoveId((idhdl)l->data);
1444  }
1445  else
1446  {
1447    l->LData()->data=L;
1448    if ((l->e!=NULL) && (l->rtyp==DEF_CMD))
1449      l->rtyp=LIST_CMD;
1450  }
1451err:
1452  o_r->CleanUp();
1453  return errorreported;
1454}
1455static BOOLEAN jjA_L_INTVEC(leftv l,leftv r,intvec *iv)
1456{
1457  /* left side is intvec/intmat, right side is list (of int,intvec,intmat)*/
1458  leftv hh=r;
1459  int i = 0;
1460  while (hh!=NULL)
1461  {
1462    if (i>=iv->length())
1463    {
1464      if (traceit&TRACE_ASSIGN)
1465      {
1466        Warn("expression list length(%d) does not match intmat size(%d)",
1467             iv->length()+exprlist_length(hh),iv->length());
1468      }
1469      break;
1470    }
1471    if (hh->Typ() == INT_CMD)
1472    {
1473      (*iv)[i++] = (int)((long)(hh->Data()));
1474    }
1475    else if ((hh->Typ() == INTVEC_CMD)
1476            ||(hh->Typ() == INTMAT_CMD))
1477    {
1478      intvec *ivv = (intvec *)(hh->Data());
1479      int ll = 0,l = si_min(ivv->length(),iv->length());
1480      for (; l>0; l--)
1481      {
1482        (*iv)[i++] = (*ivv)[ll++];
1483      }
1484    }
1485    else
1486    {
1487      delete iv;
1488      return TRUE;
1489    }
1490    hh = hh->next;
1491  }
1492  if (l->rtyp==IDHDL)
1493  {
1494    if (IDINTVEC((idhdl)l->data)!=NULL) delete IDINTVEC((idhdl)l->data);
1495    IDINTVEC((idhdl)l->data)=iv;
1496  }
1497  else
1498  {
1499    if (l->data!=NULL) delete ((intvec*)l->data);
1500    l->data=(char*)iv;
1501  }
1502  return FALSE;
1503}
1504static BOOLEAN jjA_L_BIGINTMAT(leftv l,leftv r,bigintmat *bim)
1505{
1506  /* left side is bigintmat, right side is list (of int,intvec,intmat)*/
1507  leftv hh=r;
1508  int i = 0;
1509  if (bim->length()==0) { WerrorS("bigintmat is 1x0"); delete bim; return TRUE; }
1510  while (hh!=NULL)
1511  {
1512    if (i>=bim->cols()*bim->rows())
1513    {
1514      if (traceit&TRACE_ASSIGN)
1515      {
1516        Warn("expression list length(%d) does not match bigintmat size(%d x %d)",
1517              exprlist_length(hh),bim->rows(),bim->cols());
1518      }
1519      break;
1520    }
1521    if (hh->Typ() == INT_CMD)
1522    {
1523      number tp = n_Init((int)((long)(hh->Data())), coeffs_BIGINT);
1524      bim->set(i++, tp);
1525      n_Delete(&tp, coeffs_BIGINT);
1526    }
1527    else if (hh->Typ() == BIGINT_CMD)
1528    {
1529      bim->set(i++, (number)(hh->Data()));
1530    }
1531    /*
1532    ((hh->Typ() == INTVEC_CMD)
1533            ||(hh->Typ() == INTMAT_CMD))
1534    {
1535      intvec *ivv = (intvec *)(hh->Data());
1536      int ll = 0,l = si_min(ivv->length(),iv->length());
1537      for (; l>0; l--)
1538      {
1539        (*iv)[i++] = (*ivv)[ll++];
1540      }
1541    }*/
1542    else
1543    {
1544      delete bim;
1545      return TRUE;
1546    }
1547    hh = hh->next;
1548  }
1549  if (IDBIMAT((idhdl)l->data)!=NULL) delete IDBIMAT((idhdl)l->data);
1550  IDBIMAT((idhdl)l->data)=bim;
1551  return FALSE;
1552}
1553static BOOLEAN jjA_L_STRING(leftv l,leftv r)
1554{
1555  /* left side is string, right side is list of string*/
1556  leftv hh=r;
1557  int sl = 1;
1558  char *s;
1559  char *t;
1560  int tl;
1561  /* find the length */
1562  while (hh!=NULL)
1563  {
1564    if (hh->Typ()!= STRING_CMD)
1565    {
1566      return TRUE;
1567    }
1568    sl += strlen((char *)hh->Data());
1569    hh = hh->next;
1570  }
1571  s = (char * )omAlloc(sl);
1572  sl=0;
1573  hh = r;
1574  while (hh!=NULL)
1575  {
1576    t=(char *)hh->Data();
1577    tl=strlen(t);
1578    memcpy(s+sl,t,tl);
1579    sl+=tl;
1580    hh = hh->next;
1581  }
1582  s[sl]='\0';
1583  omFree((ADDRESS)IDDATA((idhdl)(l->data)));
1584  IDDATA((idhdl)(l->data))=s;
1585  return FALSE;
1586}
1587static BOOLEAN jiA_MATRIX_L(leftv l,leftv r)
1588{
1589  /* right side is matrix, left side is list (of poly)*/
1590  BOOLEAN nok=FALSE;
1591  int i;
1592  matrix m=(matrix)r->CopyD(MATRIX_CMD);
1593  leftv h;
1594  leftv ol=l;
1595  leftv o_r=r;
1596  sleftv t;
1597  memset(&t,0,sizeof(sleftv));
1598  t.rtyp=POLY_CMD;
1599  int mxn=MATROWS(m)*MATCOLS(m);
1600  loop
1601  {
1602    i=0;
1603    while ((i<mxn /*MATROWS(m)*MATCOLS(m)*/)&&(l!=NULL))
1604    {
1605      t.data=(char *)m->m[i];
1606      m->m[i]=NULL;
1607      h=l->next;
1608      l->next=NULL;
1609      idhdl hh=NULL;
1610      if ((l->rtyp==IDHDL)&&(l->Typ()==DEF_CMD)) hh=(idhdl)l->data;
1611      nok=jiAssign_1(l,&t,TRUE);
1612      if (hh!=NULL) { ipMoveId(hh);hh=NULL;}
1613      l->next=h;
1614      if (nok)
1615      {
1616        idDelete((ideal *)&m);
1617        goto ende;
1618      }
1619      i++;
1620      l=h;
1621    }
1622    idDelete((ideal *)&m);
1623    h=r;
1624    r=r->next;
1625    if (l==NULL)
1626    {
1627      if (r!=NULL)
1628      {
1629        Warn("list length mismatch in assign (l>r)");
1630        nok=TRUE;
1631      }
1632      break;
1633    }
1634    else if (r==NULL)
1635    {
1636      Warn("list length mismatch in assign (l<r)");
1637      nok=TRUE;
1638      break;
1639    }
1640    if ((r->Typ()==IDEAL_CMD)||(r->Typ()==MATRIX_CMD))
1641    {
1642      m=(matrix)r->CopyD(MATRIX_CMD);
1643      mxn=MATROWS(m)*MATCOLS(m);
1644    }
1645    else if (r->Typ()==POLY_CMD)
1646    {
1647      m=mpNew(1,1);
1648      MATELEM(m,1,1)=(poly)r->CopyD(POLY_CMD);
1649      pNormalize(MATELEM(m,1,1));
1650      mxn=1;
1651    }
1652    else
1653    {
1654      nok=TRUE;
1655      break;
1656    }
1657  }
1658ende:
1659  o_r->CleanUp();
1660  ol->CleanUp();
1661  return nok;
1662}
1663static BOOLEAN jiA_STRING_L(leftv l,leftv r)
1664{
1665  /*left side are strings, right side is a string*/
1666  /*e.g. s[2..3]="12" */
1667  /*the case s=t[1..4] is handled in iiAssign,
1668  * the case s[2..3]=t[3..4] is handled in iiAssgn_rec*/
1669  BOOLEAN nok=FALSE;
1670  sleftv t;
1671  leftv h,l1=l;
1672  int i=0;
1673  char *ss;
1674  char *s=(char *)r->Data();
1675  int sl=strlen(s);
1676
1677  memset(&t,0,sizeof(sleftv));
1678  t.rtyp=STRING_CMD;
1679  while ((i<sl)&&(l!=NULL))
1680  {
1681    ss=(char *)omAlloc(2);
1682    ss[1]='\0';
1683    ss[0]=s[i];
1684    t.data=ss;
1685    h=l->next;
1686    l->next=NULL;
1687    nok=jiAssign_1(l,&t,TRUE);
1688    if (nok)
1689    {
1690      break;
1691    }
1692    i++;
1693    l=h;
1694  }
1695  r->CleanUp();
1696  l1->CleanUp();
1697  return nok;
1698}
1699static BOOLEAN jiAssign_list(leftv l, leftv r)
1700{
1701  int i=l->e->start-1;
1702  if (i<0)
1703  {
1704    Werror("index[%d] must be positive",i+1);
1705    return TRUE;
1706  }
1707  if(l->attribute!=NULL)
1708  {
1709    atKillAll((idhdl)l);
1710    l->attribute=NULL;
1711  }
1712  l->flag=0;
1713  lists li;
1714  if (l->rtyp==IDHDL)
1715  {
1716    li=IDLIST((idhdl)l->data);
1717  }
1718  else
1719  {
1720    li=(lists)l->data;
1721  }
1722  if (i>li->nr)
1723  {
1724    if (TEST_V_ALLWARN)
1725    {
1726      Warn("increase list %d -> %d in %s",li->nr,i,my_yylinebuf);
1727    }
1728    li->m=(leftv)omreallocSize(li->m,(li->nr+1)*sizeof(sleftv),(i+1)*sizeof(sleftv));
1729    memset(&(li->m[li->nr+1]),0,(i-li->nr)*sizeof(sleftv));
1730    int j=li->nr+1;
1731    for(;j<=i;j++)
1732      li->m[j].rtyp=DEF_CMD;
1733    li->nr=i;
1734  }
1735  leftv ld=&(li->m[i]);
1736  ld->e=l->e->next;
1737  BOOLEAN b;
1738  if (/*(ld->rtyp!=LIST_CMD)
1739  &&*/(ld->e==NULL)
1740  && (ld->Typ()!=r->Typ()))
1741  {
1742    sleftv tmp;
1743    memset(&tmp,0,sizeof(sleftv));
1744    tmp.rtyp=DEF_CMD;
1745    b=iiAssign(&tmp,r,FALSE);
1746    ld->CleanUp();
1747    memcpy(ld,&tmp,sizeof(sleftv));
1748  }
1749  else if ((ld->e==NULL)
1750  && (ld->Typ()==r->Typ())
1751  && (ld->Typ()<MAX_TOK))
1752  {
1753    sleftv tmp;
1754    memset(&tmp,0,sizeof(sleftv));
1755    tmp.rtyp=r->Typ();
1756    tmp.data=(char*)idrecDataInit(r->Typ());
1757    b=iiAssign(&tmp,r,FALSE);
1758    ld->CleanUp();
1759    memcpy(ld,&tmp,sizeof(sleftv));
1760  }
1761  else
1762  {
1763    b=iiAssign(ld,r,FALSE);
1764    if (l->e!=NULL) l->e->next=ld->e;
1765    ld->e=NULL;
1766  }
1767  return b;
1768}
1769static BOOLEAN jiAssign_rec(leftv l, leftv r)
1770{
1771  leftv l1=l;
1772  leftv r1=r;
1773  leftv lrest;
1774  leftv rrest;
1775  BOOLEAN b;
1776  do
1777  {
1778    lrest=l->next;
1779    rrest=r->next;
1780    l->next=NULL;
1781    r->next=NULL;
1782    b=iiAssign(l,r);
1783    l->next=lrest;
1784    r->next=rrest;
1785    l=lrest;
1786    r=rrest;
1787  } while  ((!b)&&(l!=NULL));
1788  l1->CleanUp();
1789  r1->CleanUp();
1790  return b;
1791}
1792BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
1793{
1794  if (errorreported) return TRUE;
1795  int ll=l->listLength();
1796  int rl;
1797  int lt=l->Typ();
1798  int rt=NONE;
1799  BOOLEAN b;
1800  if (l->rtyp==ALIAS_CMD)
1801  {
1802    Werror("`%s` is read-only",l->Name());
1803  }
1804
1805  if (l->rtyp==IDHDL)
1806  {
1807    atKillAll((idhdl)l->data);
1808    IDFLAG((idhdl)l->data)=0;
1809    l->attribute=NULL;
1810    toplevel=FALSE;
1811  }
1812  else if (l->attribute!=NULL)
1813    atKillAll((idhdl)l);
1814  l->flag=0;
1815  if (ll==1)
1816  {
1817    /* l[..] = ... */
1818    if(l->e!=NULL)
1819    {
1820      BOOLEAN like_lists=0;
1821      blackbox *bb=NULL;
1822      int bt;
1823      if (((bt=l->rtyp)>MAX_TOK)
1824      || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1825      {
1826        bb=getBlackboxStuff(bt);
1827        like_lists=BB_LIKE_LIST(bb); // bb like a list
1828      }
1829      else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1830        || (l->rtyp==LIST_CMD))
1831      {
1832        like_lists=2; // bb in a list
1833      }
1834      if(like_lists)
1835      {
1836        if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
1837        if (like_lists==1)
1838        {
1839          // check blackbox/newtype type:
1840          if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
1841        }
1842        b=jiAssign_list(l,r);
1843        if((!b) && (like_lists==2))
1844        {
1845          //Print("jjA_L_LIST: - 2 \n");
1846          if((l->rtyp==IDHDL) && (l->data!=NULL))
1847          {
1848            ipMoveId((idhdl)l->data);
1849            l->attribute=IDATTR((idhdl)l->data);
1850            l->flag=IDFLAG((idhdl)l->data);
1851          }
1852        }
1853        r->CleanUp();
1854        Subexpr h;
1855        while (l->e!=NULL)
1856        {
1857          h=l->e->next;
1858          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1859          l->e=h;
1860        }
1861        return b;
1862      }
1863    }
1864    if (lt>MAX_TOK)
1865    {
1866      blackbox *bb=getBlackboxStuff(lt);
1867#ifdef BLACKBOX_DEVEL
1868      Print("bb-assign: bb=%lx\n",bb);
1869#endif
1870      return (bb==NULL) || bb->blackbox_Assign(l,r);
1871    }
1872    // end of handling elems of list and similar
1873    rl=r->listLength();
1874    if (rl==1)
1875    {
1876      /* system variables = ... */
1877      if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1878      ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1879      {
1880        b=iiAssign_sys(l,r);
1881        r->CleanUp();
1882        //l->CleanUp();
1883        return b;
1884      }
1885      rt=r->Typ();
1886      /* a = ... */
1887      if ((lt!=MATRIX_CMD)
1888      &&(lt!=BIGINTMAT_CMD)
1889      &&(lt!=CMATRIX_CMD)
1890      &&(lt!=INTMAT_CMD)
1891      &&((lt==rt)||(lt!=LIST_CMD)))
1892      {
1893        b=jiAssign_1(l,r,toplevel);
1894        if (l->rtyp==IDHDL)
1895        {
1896          if ((lt==DEF_CMD)||(lt==LIST_CMD))
1897          {
1898            ipMoveId((idhdl)l->data);
1899          }
1900          l->attribute=IDATTR((idhdl)l->data);
1901          l->flag=IDFLAG((idhdl)l->data);
1902          l->CleanUp();
1903        }
1904        r->CleanUp();
1905        return b;
1906      }
1907      if (((lt!=LIST_CMD)
1908        &&((rt==MATRIX_CMD)
1909          ||(rt==BIGINTMAT_CMD)
1910          ||(rt==CMATRIX_CMD)
1911          ||(rt==INTMAT_CMD)
1912          ||(rt==INTVEC_CMD)
1913          ||(rt==MODUL_CMD)))
1914      ||((lt==LIST_CMD)
1915        &&(rt==RESOLUTION_CMD))
1916      )
1917      {
1918        b=jiAssign_1(l,r,toplevel);
1919        if((l->rtyp==IDHDL)&&(l->data!=NULL))
1920        {
1921          if ((lt==DEF_CMD) || (lt==LIST_CMD))
1922          {
1923            //Print("ipAssign - 3.0\n");
1924            ipMoveId((idhdl)l->data);
1925          }
1926          l->attribute=IDATTR((idhdl)l->data);
1927          l->flag=IDFLAG((idhdl)l->data);
1928        }
1929        r->CleanUp();
1930        Subexpr h;
1931        while (l->e!=NULL)
1932        {
1933          h=l->e->next;
1934          omFreeBin((ADDRESS)l->e, sSubexpr_bin);
1935          l->e=h;
1936        }
1937        return b;
1938      }
1939    }
1940    if (rt==NONE) rt=r->Typ();
1941  }
1942  else if (ll==(rl=r->listLength()))
1943  {
1944    b=jiAssign_rec(l,r);
1945    return b;
1946  }
1947  else
1948  {
1949    if (rt==NONE) rt=r->Typ();
1950    if (rt==INTVEC_CMD)
1951      return jiA_INTVEC_L(l,r);
1952    else if (rt==VECTOR_CMD)
1953      return jiA_VECTOR_L(l,r);
1954    else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1955      return jiA_MATRIX_L(l,r);
1956    else if ((rt==STRING_CMD)&&(rl==1))
1957      return jiA_STRING_L(l,r);
1958    Werror("length of lists in assignment does not match (l:%d,r:%d)",
1959      ll,rl);
1960    return TRUE;
1961  }
1962
1963  leftv hh=r;
1964  BOOLEAN nok=FALSE;
1965  BOOLEAN map_assign=FALSE;
1966  switch (lt)
1967  {
1968    case INTVEC_CMD:
1969      nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
1970      break;
1971    case INTMAT_CMD:
1972    {
1973      nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
1974      break;
1975    }
1976    case BIGINTMAT_CMD:
1977    {
1978      nok=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
1979      break;
1980    }
1981    case MAP_CMD:
1982    {
1983      // first element in the list sl (r) must be a ring
1984      if ((rt == RING_CMD)&&(r->e==NULL))
1985      {
1986        omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
1987        IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
1988        /* advance the expressionlist to get the next element after the ring */
1989        hh = r->next;
1990        //r=hh;
1991      }
1992      else
1993      {
1994        WerrorS("expected ring-name");
1995        nok=TRUE;
1996        break;
1997      }
1998      if (hh==NULL) /* map-assign: map f=r; */
1999      {
2000        WerrorS("expected image ideal");
2001        nok=TRUE;
2002        break;
2003      }
2004      if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2005        return jiAssign_1(l,hh,toplevel); /* map-assign: map f=r,i; */
2006      //no break, handle the rest like an ideal:
2007      map_assign=TRUE;
2008    }
2009    case MATRIX_CMD:
2010    case IDEAL_CMD:
2011    case MODUL_CMD:
2012    {
2013      sleftv t;
2014      matrix olm = (matrix)l->Data();
2015      int rk;
2016      char *pr=((map)olm)->preimage;
2017      BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2018      matrix lm ;
2019      int  num;
2020      int j,k;
2021      int i=0;
2022      int mtyp=MATRIX_CMD; /*Type of left side object*/
2023      int etyp=POLY_CMD;   /*Type of elements of left side object*/
2024
2025      if (lt /*l->Typ()*/==MATRIX_CMD)
2026      {
2027        rk=olm->rows();
2028        num=olm->cols()*rk /*olm->rows()*/;
2029        lm=mpNew(olm->rows(),olm->cols());
2030        int el;
2031        if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2032        {
2033          Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2034        }
2035      }
2036      else /* IDEAL_CMD or MODUL_CMD */
2037      {
2038        num=exprlist_length(hh);
2039        lm=(matrix)idInit(num,1);
2040        if (module_assign)
2041        {
2042          rk=0;
2043          mtyp=MODUL_CMD;
2044          etyp=VECTOR_CMD;
2045        }
2046        else
2047          rk=1;
2048      }
2049
2050      int ht;
2051      loop
2052      {
2053        if (hh==NULL)
2054          break;
2055        else
2056        {
2057          matrix rm;
2058          ht=hh->Typ();
2059          if ((j=iiTestConvert(ht,etyp))!=0)
2060          {
2061            nok=iiConvert(ht,etyp,j,hh,&t);
2062            hh->next=t.next;
2063            if (nok) break;
2064            lm->m[i]=(poly)t.CopyD(etyp);
2065            pNormalize(lm->m[i]);
2066            if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
2067            i++;
2068          }
2069          else
2070          if ((j=iiTestConvert(ht,mtyp))!=0)
2071          {
2072            nok=iiConvert(ht,mtyp,j,hh,&t);
2073            hh->next=t.next;
2074            if (nok) break;
2075            rm = (matrix)t.CopyD(mtyp);
2076            if (module_assign)
2077            {
2078              j = si_min(num,rm->cols());
2079              rk=si_max(rk,(int)rm->rank);
2080            }
2081            else
2082              j = si_min(num-i,rm->rows() * rm->cols());
2083            for(k=0;k<j;k++,i++)
2084            {
2085              lm->m[i]=rm->m[k];
2086              pNormalize(lm->m[i]);
2087              rm->m[k]=NULL;
2088            }
2089            idDelete((ideal *)&rm);
2090          }
2091          else
2092          {
2093            nok=TRUE;
2094            break;
2095          }
2096          t.next=NULL;t.CleanUp();
2097          if (i==num) break;
2098          hh=hh->next;
2099        }
2100      }
2101      if (nok)
2102        idDelete((ideal *)&lm);
2103      else
2104      {
2105        idDelete((ideal *)&olm);
2106        if (module_assign)   lm->rank=rk;
2107        else if (map_assign) ((map)lm)->preimage=pr;
2108        l=l->LData();
2109        if (l->rtyp==IDHDL)
2110          IDMATRIX((idhdl)l->data)=lm;
2111        else
2112          l->data=(char *)lm;
2113      }
2114      break;
2115    }
2116    case STRING_CMD:
2117      nok=jjA_L_STRING(l,r);
2118      break;
2119    //case DEF_CMD:
2120    case LIST_CMD:
2121      nok=jjA_L_LIST(l,r);
2122      break;
2123    case NONE:
2124    case 0:
2125      Werror("cannot assign to %s",l->Fullname());
2126      nok=TRUE;
2127      break;
2128    default:
2129      WerrorS("assign not impl.");
2130      nok=TRUE;
2131      break;
2132  } /* end switch: typ */
2133  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
2134  r->CleanUp();
2135  return nok;
2136}
2137void jjNormalizeQRingId(leftv I)
2138{
2139  if ((currRing->qideal!=NULL) && (!hasFlag(I,FLAG_QRING)))
2140  {
2141    if (I->e==NULL)
2142    {
2143      ideal I0=(ideal)I->Data();
2144      switch (I->Typ())
2145      {
2146        case IDEAL_CMD:
2147        case MODUL_CMD:
2148        {
2149          ideal F=idInit(1,1);
2150          ideal II=kNF(F,currRing->qideal,I0);
2151          idDelete(&F);
2152          if (I->rtyp!=IDHDL)
2153          {
2154            idDelete((ideal*)&(I0));
2155            I->data=II;
2156          }
2157          else
2158          {
2159            idhdl h=(idhdl)I->data;
2160            idDelete((ideal*)&IDIDEAL(h));
2161            IDIDEAL(h)=II;
2162            setFlag(h,FLAG_QRING);
2163          }
2164          break;
2165        }
2166        default: break;
2167      }
2168      setFlag(I,FLAG_QRING);
2169    }
2170  }
2171}
2172void jjNormalizeQRingP(poly &p)
2173{
2174  if((p!=NULL) && (currRing->qideal!=NULL))
2175  {
2176    ideal F=idInit(1,1);
2177    poly p2=kNF(F,currRing->qideal,p);
2178    pNormalize(p2);
2179    idDelete(&F);
2180    pDelete(&p);
2181    p=p2;
2182  }
2183}
2184BOOLEAN jjIMPORTFROM(leftv, leftv u, leftv v)
2185{
2186  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2187  assume(u->Typ()==PACKAGE_CMD);
2188  char *vn=(char *)v->Name();
2189  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2190  if (h!=NULL)
2191  {
2192    //check for existence
2193    if (((package)(u->Data()))==basePack)
2194    {
2195      WarnS("source and destination packages are identical");
2196      return FALSE;
2197    }
2198    idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2199    if (t!=NULL)
2200    {
2201      if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2202      killhdl(t);
2203    }
2204    sleftv tmp_expr;
2205    if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2206    sleftv h_expr;
2207    memset(&h_expr,0,sizeof(h_expr));
2208    h_expr.rtyp=IDHDL;
2209    h_expr.data=h;
2210    h_expr.name=vn;
2211    return iiAssign(&tmp_expr,&h_expr);
2212  }
2213  else
2214  {
2215    Werror("`%s` not found in `%s`",v->Name(), u->Name());
2216    return TRUE;
2217  }
2218  return FALSE;
2219}
Note: See TracBrowser for help on using the repository browser.