source: git/Singular/ipassign.cc @ 1beccea

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