source: git/Singular/ipassign.cc @ 88615db

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