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