PageRenderTime 158ms CodeModel.GetById 12ms app.highlight 134ms RepoModel.GetById 1ms app.codeStats 0ms

/Singular/ipassign.cc

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