PageRenderTime 106ms CodeModel.GetById 14ms RepoModel.GetById 1ms app.codeStats 2ms

/Singular/iparith.cc

https://github.com/hannes14/Singular
C++ | 8472 lines | 7854 code | 158 blank | 460 comment | 1284 complexity | dfe4cc164433101cb4db6645b28a00b4 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: table driven kernel interface, used by interpreter
  7. */
  8. #include <stdlib.h>
  9. #include <string.h>
  10. #include <ctype.h>
  11. #include <stdio.h>
  12. #include <time.h>
  13. #include <unistd.h>
  14. #include <kernel/mod2.h>
  15. #include <Singular/tok.h>
  16. #include <kernel/options.h>
  17. #include <Singular/ipid.h>
  18. #include <kernel/intvec.h>
  19. #include <omalloc/omalloc.h>
  20. #include <kernel/polys.h>
  21. #include <kernel/febase.h>
  22. #include <Singular/sdb.h>
  23. #include <kernel/longalg.h>
  24. #include <kernel/longtrans.h>
  25. #include <kernel/ideals.h>
  26. #include <kernel/prCopy.h>
  27. #include <kernel/matpol.h>
  28. #include <kernel/kstd1.h>
  29. #include <kernel/timer.h>
  30. #include <kernel/ring.h>
  31. #include <Singular/subexpr.h>
  32. #include <Singular/lists.h>
  33. #include <kernel/modulop.h>
  34. #ifdef HAVE_RINGS
  35. #include <kernel/rmodulon.h>
  36. #include <kernel/rmodulo2m.h>
  37. #include <kernel/rintegers.h>
  38. #endif
  39. #include <kernel/numbers.h>
  40. #include <kernel/stairc.h>
  41. #include <kernel/maps.h>
  42. #include <Singular/maps_ip.h>
  43. #include <kernel/syz.h>
  44. #include <kernel/weight.h>
  45. #include <Singular/ipconv.h>
  46. #include <Singular/ipprint.h>
  47. #include <Singular/attrib.h>
  48. #include <Singular/silink.h>
  49. #include <kernel/sparsmat.h>
  50. #include <kernel/units.h>
  51. #include <Singular/janet.h>
  52. #include <kernel/GMPrat.h>
  53. #include <kernel/tgb.h>
  54. #include <kernel/walkProc.h>
  55. #include <kernel/mod_raw.h>
  56. #include <Singular/MinorInterface.h>
  57. #include <kernel/linearAlgebra.h>
  58. #include <Singular/misc_ip.h>
  59. #ifdef HAVE_FACTORY
  60. # include <kernel/clapsing.h>
  61. # include <kernel/kstdfac.h>
  62. #endif /* HAVE_FACTORY */
  63. #ifdef HAVE_FACTORY
  64. # include <kernel/fglm.h>
  65. #endif /* HAVE_FACTORY */
  66. #include <Singular/interpolation.h>
  67. #include <Singular/blackbox.h>
  68. #include <Singular/newstruct.h>
  69. #include <Singular/ipshell.h>
  70. #include <kernel/mpr_inout.h>
  71. #include <kernel/timer.h>
  72. // defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
  73. #ifdef HAVE_PLURAL
  74. #include <kernel/gring.h>
  75. #include <kernel/sca.h>
  76. #define ALLOW_PLURAL 1
  77. #define NO_PLURAL 0
  78. #define COMM_PLURAL 2
  79. #define PLURAL_MASK 3
  80. #else /* HAVE_PLURAL */
  81. #define ALLOW_PLURAL 0
  82. #define NO_PLURAL 0
  83. #define COMM_PLURAL 0
  84. #define PLURAL_MASK 0
  85. #endif /* HAVE_PLURAL */
  86. #ifdef HAVE_RINGS
  87. #define RING_MASK 4
  88. #define ZERODIVISOR_MASK 8
  89. #else
  90. #define RING_MASK 0
  91. #define ZERODIVISOR_MASK 0
  92. #endif
  93. #define ALLOW_RING 4
  94. #define NO_RING 0
  95. #define NO_ZERODIVISOR 8
  96. #define ALLOW_ZERODIVISOR 0
  97. static BOOLEAN check_valid(const int p, const int op);
  98. /*=============== types =====================*/
  99. struct sValCmdTab
  100. {
  101. short cmd;
  102. short start;
  103. };
  104. typedef sValCmdTab jjValCmdTab[];
  105. struct _scmdnames
  106. {
  107. char *name;
  108. short alias;
  109. short tokval;
  110. short toktype;
  111. };
  112. typedef struct _scmdnames cmdnames;
  113. typedef char * (*Proc1)(char *);
  114. struct sValCmd1
  115. {
  116. proc1 p;
  117. short cmd;
  118. short res;
  119. short arg;
  120. short valid_for;
  121. };
  122. typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
  123. struct sValCmd2
  124. {
  125. proc2 p;
  126. short cmd;
  127. short res;
  128. short arg1;
  129. short arg2;
  130. short valid_for;
  131. };
  132. typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
  133. struct sValCmd3
  134. {
  135. proc3 p;
  136. short cmd;
  137. short res;
  138. short arg1;
  139. short arg2;
  140. short arg3;
  141. short valid_for;
  142. };
  143. struct sValCmdM
  144. {
  145. proc1 p;
  146. short cmd;
  147. short res;
  148. short number_of_args; /* -1: any, -2: any >0, .. */
  149. short valid_for;
  150. };
  151. typedef struct
  152. {
  153. cmdnames *sCmds; /**< array of existing commands */
  154. struct sValCmd1 *psValCmd1;
  155. struct sValCmd2 *psValCmd2;
  156. struct sValCmd3 *psValCmd3;
  157. struct sValCmdM *psValCmdM;
  158. int nCmdUsed; /**< number of commands used */
  159. int nCmdAllocated; /**< number of commands-slots allocated */
  160. int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
  161. } SArithBase;
  162. /*---------------------------------------------------------------------*
  163. * File scope Variables (Variables share by several functions in
  164. * the same file )
  165. *
  166. *---------------------------------------------------------------------*/
  167. static SArithBase sArithBase; /**< Base entry for arithmetic */
  168. /*---------------------------------------------------------------------*
  169. * Extern Functions declarations
  170. *
  171. *---------------------------------------------------------------------*/
  172. static int _gentable_sort_cmds(const void *a, const void *b);
  173. extern int iiArithRemoveCmd(char *szName);
  174. extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
  175. short nToktype, short nPos=-1);
  176. /*============= proc =======================*/
  177. static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
  178. static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
  179. #ifdef MDEBUG
  180. #define jjMakeSub(A) jjDBMakeSub(A,__FILE__,__LINE__)
  181. static Subexpr jjDBMakeSub(leftv e,const char *f,const int l);
  182. #else
  183. static Subexpr jjMakeSub(leftv e);
  184. #endif
  185. /*============= vars ======================*/
  186. extern int cmdtok;
  187. extern BOOLEAN expected_parms;
  188. #define ii_div_by_0 "div. by 0"
  189. int iiOp; /* the current operation*/
  190. /*=================== operations with 2 args.: static proc =================*/
  191. /* must be ordered: first operations for chars (infix ops),
  192. * then alphabetically */
  193. static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
  194. {
  195. intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
  196. int bb = (int)(long)(v->Data());
  197. if (errorreported) return TRUE;
  198. switch (iiOp)
  199. {
  200. case '+': (*aa) += bb; break;
  201. case '-': (*aa) -= bb; break;
  202. case '*': (*aa) *= bb; break;
  203. case '/':
  204. case INTDIV_CMD: (*aa) /= bb; break;
  205. case '%':
  206. case INTMOD_CMD: (*aa) %= bb; break;
  207. }
  208. res->data=(char *)aa;
  209. return FALSE;
  210. }
  211. static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
  212. {
  213. return jjOP_IV_I(res,v,u);
  214. }
  215. static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
  216. {
  217. intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
  218. int bb = (int)(long)(v->Data());
  219. int i=si_min(aa->rows(),aa->cols());
  220. switch (iiOp)
  221. {
  222. case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
  223. break;
  224. case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
  225. break;
  226. }
  227. res->data=(char *)aa;
  228. return FALSE;
  229. }
  230. static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
  231. {
  232. return jjOP_IM_I(res,v,u);
  233. }
  234. static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
  235. {
  236. int l=(int)(long)v->Data();
  237. if (l>0)
  238. {
  239. int d=(int)(long)u->Data();
  240. intvec *vv=new intvec(l);
  241. int i;
  242. for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
  243. res->data=(char *)vv;
  244. }
  245. return (l<=0);
  246. }
  247. static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
  248. {
  249. res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
  250. return FALSE;
  251. }
  252. static void jjEQUAL_REST(leftv res,leftv u,leftv v);
  253. static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
  254. {
  255. intvec* a = (intvec * )(u->Data());
  256. intvec* b = (intvec * )(v->Data());
  257. int r=a->compare(b);
  258. switch (iiOp)
  259. {
  260. case '<':
  261. res->data = (char *) (r<0);
  262. break;
  263. case '>':
  264. res->data = (char *) (r>0);
  265. break;
  266. case LE:
  267. res->data = (char *) (r<=0);
  268. break;
  269. case GE:
  270. res->data = (char *) (r>=0);
  271. break;
  272. case EQUAL_EQUAL:
  273. case NOTEQUAL: /* negation handled by jjEQUAL_REST */
  274. res->data = (char *) (r==0);
  275. break;
  276. }
  277. jjEQUAL_REST(res,u,v);
  278. if(r==-2) { WerrorS("size incompatible"); return TRUE; }
  279. return FALSE;
  280. }
  281. static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
  282. {
  283. intvec* a = (intvec * )(u->Data());
  284. int b = (int)(long)(v->Data());
  285. int r=a->compare(b);
  286. switch (iiOp)
  287. {
  288. case '<':
  289. res->data = (char *) (r<0);
  290. break;
  291. case '>':
  292. res->data = (char *) (r>0);
  293. break;
  294. case LE:
  295. res->data = (char *) (r<=0);
  296. break;
  297. case GE:
  298. res->data = (char *) (r>=0);
  299. break;
  300. case EQUAL_EQUAL:
  301. case NOTEQUAL: /* negation handled by jjEQUAL_REST */
  302. res->data = (char *) (r==0);
  303. break;
  304. }
  305. jjEQUAL_REST(res,u,v);
  306. return FALSE;
  307. }
  308. static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
  309. {
  310. poly p=(poly)u->Data();
  311. poly q=(poly)v->Data();
  312. int r=pCmp(p,q);
  313. if (r==0)
  314. {
  315. number h=nSub(pGetCoeff(p),pGetCoeff(q));
  316. /* compare lead coeffs */
  317. r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
  318. nDelete(&h);
  319. }
  320. else if (p==NULL)
  321. {
  322. if (q==NULL)
  323. {
  324. /* compare 0, 0 */
  325. r=0;
  326. }
  327. else if(pIsConstant(q))
  328. {
  329. /* compare 0, const */
  330. r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
  331. }
  332. }
  333. else if (q==NULL)
  334. {
  335. if (pIsConstant(p))
  336. {
  337. /* compare const, 0 */
  338. r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
  339. }
  340. }
  341. switch (iiOp)
  342. {
  343. case '<':
  344. res->data = (char *) (r < 0);
  345. break;
  346. case '>':
  347. res->data = (char *) (r > 0);
  348. break;
  349. case LE:
  350. res->data = (char *) (r <= 0);
  351. break;
  352. case GE:
  353. res->data = (char *) (r >= 0);
  354. break;
  355. //case EQUAL_EQUAL:
  356. //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
  357. // res->data = (char *) (r == 0);
  358. // break;
  359. }
  360. jjEQUAL_REST(res,u,v);
  361. return FALSE;
  362. }
  363. static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
  364. {
  365. char* a = (char * )(u->Data());
  366. char* b = (char * )(v->Data());
  367. int result = strcmp(a,b);
  368. switch (iiOp)
  369. {
  370. case '<':
  371. res->data = (char *) (result < 0);
  372. break;
  373. case '>':
  374. res->data = (char *) (result > 0);
  375. break;
  376. case LE:
  377. res->data = (char *) (result <= 0);
  378. break;
  379. case GE:
  380. res->data = (char *) (result >= 0);
  381. break;
  382. case EQUAL_EQUAL:
  383. case NOTEQUAL: /* negation handled by jjEQUAL_REST */
  384. res->data = (char *) (result == 0);
  385. break;
  386. }
  387. jjEQUAL_REST(res,u,v);
  388. return FALSE;
  389. }
  390. static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
  391. {
  392. if (u->Next()!=NULL)
  393. {
  394. u=u->next;
  395. res->next = (leftv)omAllocBin(sleftv_bin);
  396. return iiExprArith2(res->next,u,iiOp,v);
  397. }
  398. else if (v->Next()!=NULL)
  399. {
  400. v=v->next;
  401. res->next = (leftv)omAllocBin(sleftv_bin);
  402. return iiExprArith2(res->next,u,iiOp,v);
  403. }
  404. return FALSE;
  405. }
  406. static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
  407. {
  408. int b=(int)(long)u->Data();
  409. int e=(int)(long)v->Data();
  410. int rc = 1;
  411. BOOLEAN overflow=FALSE;
  412. if (e >= 0)
  413. {
  414. if (b==0)
  415. {
  416. rc=(e==0);
  417. }
  418. else
  419. {
  420. int oldrc;
  421. while ((e--)!=0)
  422. {
  423. oldrc=rc;
  424. rc *= b;
  425. if (!overflow)
  426. {
  427. if(rc/b!=oldrc) overflow=TRUE;
  428. }
  429. }
  430. if (overflow)
  431. WarnS("int overflow(^), result may be wrong");
  432. }
  433. res->data = (char *)((long)rc);
  434. if (u!=NULL) return jjOP_REST(res,u,v);
  435. return FALSE;
  436. }
  437. else
  438. {
  439. WerrorS("exponent must be non-negative");
  440. return TRUE;
  441. }
  442. }
  443. static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
  444. {
  445. int e=(int)(long)v->Data();
  446. number n=(number)u->Data();
  447. if (e>=0)
  448. {
  449. nlPower(n,e,(number*)&res->data);
  450. }
  451. else
  452. {
  453. WerrorS("exponent must be non-negative");
  454. return TRUE;
  455. }
  456. if (u!=NULL) return jjOP_REST(res,u,v);
  457. return FALSE;
  458. }
  459. static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
  460. {
  461. int e=(int)(long)v->Data();
  462. number n=(number)u->Data();
  463. int d=0;
  464. if (e<0)
  465. {
  466. n=nInvers(n);
  467. e=-e;
  468. d=1;
  469. }
  470. nPower(n,e,(number*)&res->data);
  471. if (d) nDelete(&n);
  472. if (u!=NULL) return jjOP_REST(res,u,v);
  473. return FALSE;
  474. }
  475. static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
  476. {
  477. int v_i=(int)(long)v->Data();
  478. if (v_i<0)
  479. {
  480. WerrorS("exponent must be non-negative");
  481. return TRUE;
  482. }
  483. poly u_p=(poly)u->CopyD(POLY_CMD);
  484. int dummy;
  485. if ((u_p!=NULL)
  486. && (pTotaldegree(u_p)*(signed long)v_i > (signed long)currRing->bitmask))
  487. {
  488. Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
  489. pTotaldegree(u_p),v_i,currRing->bitmask);
  490. pDelete(&u_p);
  491. return TRUE;
  492. }
  493. res->data = (char *)pPower(u_p,v_i);
  494. if (u!=NULL) return jjOP_REST(res,u,v);
  495. return errorreported; /* pPower may set errorreported via Werror */
  496. }
  497. static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
  498. {
  499. res->data = (char *)idPower((ideal)(u->Data()),(int)(long)(v->Data()));
  500. if (u!=NULL) return jjOP_REST(res,u,v);
  501. return FALSE;
  502. }
  503. static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
  504. {
  505. u=u->next;
  506. v=v->next;
  507. if (u==NULL)
  508. {
  509. if (v==NULL) return FALSE; /* u==NULL, v==NULL */
  510. if (iiOp=='-') /* u==NULL, v<>NULL, iiOp=='-'*/
  511. {
  512. do
  513. {
  514. if (res->next==NULL)
  515. res->next = (leftv)omAlloc0Bin(sleftv_bin);
  516. leftv tmp_v=v->next;
  517. v->next=NULL;
  518. BOOLEAN b=iiExprArith1(res->next,v,'-');
  519. v->next=tmp_v;
  520. if (b)
  521. return TRUE;
  522. v=tmp_v;
  523. res=res->next;
  524. } while (v!=NULL);
  525. return FALSE;
  526. }
  527. loop /* u==NULL, v<>NULL, iiOp=='+' */
  528. {
  529. res->next = (leftv)omAlloc0Bin(sleftv_bin);
  530. res=res->next;
  531. res->data = v->CopyD();
  532. res->rtyp = v->Typ();
  533. v=v->next;
  534. if (v==NULL) return FALSE;
  535. }
  536. }
  537. if (v!=NULL) /* u<>NULL, v<>NULL */
  538. {
  539. do
  540. {
  541. res->next = (leftv)omAlloc0Bin(sleftv_bin);
  542. leftv tmp_u=u->next; u->next=NULL;
  543. leftv tmp_v=v->next; v->next=NULL;
  544. BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
  545. u->next=tmp_u;
  546. v->next=tmp_v;
  547. if (b)
  548. return TRUE;
  549. u=tmp_u;
  550. v=tmp_v;
  551. res=res->next;
  552. } while ((u!=NULL) && (v!=NULL));
  553. return FALSE;
  554. }
  555. loop /* u<>NULL, v==NULL */
  556. {
  557. res->next = (leftv)omAlloc0Bin(sleftv_bin);
  558. res=res->next;
  559. res->data = u->CopyD();
  560. res->rtyp = u->Typ();
  561. u=u->next;
  562. if (u==NULL) return FALSE;
  563. }
  564. }
  565. static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
  566. {
  567. idhdl packhdl;
  568. switch(u->Typ())
  569. {
  570. case 0:
  571. Print("%s of type 'ANY'. Trying load.\n", v->name);
  572. if(iiTryLoadLib(u, u->name))
  573. {
  574. Werror("'%s' no such package", u->name);
  575. return TRUE;
  576. }
  577. syMake(u,u->name,NULL);
  578. // else: use next case !!! no break !!!
  579. case PACKAGE_CMD:
  580. packhdl = (idhdl)u->data;
  581. if((!IDPACKAGE(packhdl)->loaded)
  582. && (IDPACKAGE(packhdl)->language > LANG_TOP))
  583. {
  584. Werror("'%s' not loaded", u->name);
  585. return TRUE;
  586. }
  587. if(v->rtyp == IDHDL)
  588. {
  589. v->name = omStrDup(v->name);
  590. }
  591. v->req_packhdl=IDPACKAGE(packhdl);
  592. syMake(v, v->name, packhdl);
  593. memcpy(res, v, sizeof(sleftv));
  594. memset(v, 0, sizeof(sleftv));
  595. break;
  596. case DEF_CMD:
  597. break;
  598. default:
  599. WerrorS("<package>::<id> expected");
  600. return TRUE;
  601. }
  602. return FALSE;
  603. }
  604. static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
  605. {
  606. unsigned int a=(unsigned int)(unsigned long)u->Data();
  607. unsigned int b=(unsigned int)(unsigned long)v->Data();
  608. unsigned int c=a+b;
  609. res->data = (char *)((long)c);
  610. if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
  611. {
  612. WarnS("int overflow(+), result may be wrong");
  613. }
  614. return jjPLUSMINUS_Gen(res,u,v);
  615. }
  616. static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
  617. {
  618. res->data = (char *)(nlAdd((number)u->Data(), (number)v->Data()));
  619. return jjPLUSMINUS_Gen(res,u,v);
  620. }
  621. static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
  622. {
  623. res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
  624. return jjPLUSMINUS_Gen(res,u,v);
  625. }
  626. static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
  627. {
  628. res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
  629. return jjPLUSMINUS_Gen(res,u,v);
  630. }
  631. static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
  632. {
  633. res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
  634. if (res->data==NULL)
  635. {
  636. WerrorS("intmat size not compatible");
  637. return TRUE;
  638. }
  639. return jjPLUSMINUS_Gen(res,u,v);
  640. return FALSE;
  641. }
  642. static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
  643. {
  644. matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
  645. res->data = (char *)(mpAdd(A , B));
  646. if (res->data==NULL)
  647. {
  648. Werror("matrix size not compatible(%dx%d, %dx%d)",
  649. MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
  650. return TRUE;
  651. }
  652. return jjPLUSMINUS_Gen(res,u,v);
  653. }
  654. static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
  655. {
  656. matrix m=(matrix)u->Data();
  657. matrix p= mpInitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)));
  658. if (iiOp=='+')
  659. res->data = (char *)mpAdd(m , p);
  660. else
  661. res->data = (char *)mpSub(m , p);
  662. idDelete((ideal *)&p);
  663. return jjPLUSMINUS_Gen(res,u,v);
  664. }
  665. static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
  666. {
  667. return jjPLUS_MA_P(res,v,u);
  668. }
  669. static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
  670. {
  671. char* a = (char * )(u->Data());
  672. char* b = (char * )(v->Data());
  673. char* r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
  674. strcpy(r,a);
  675. strcat(r,b);
  676. res->data=r;
  677. return jjPLUSMINUS_Gen(res,u,v);
  678. }
  679. static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
  680. {
  681. res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
  682. return jjPLUSMINUS_Gen(res,u,v);
  683. }
  684. static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
  685. {
  686. void *ap=u->Data(); void *bp=v->Data();
  687. int aa=(int)(long)ap;
  688. int bb=(int)(long)bp;
  689. int cc=aa-bb;
  690. unsigned int a=(unsigned int)(unsigned long)ap;
  691. unsigned int b=(unsigned int)(unsigned long)bp;
  692. unsigned int c=a-b;
  693. if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
  694. {
  695. WarnS("int overflow(-), result may be wrong");
  696. }
  697. res->data = (char *)((long)cc);
  698. return jjPLUSMINUS_Gen(res,u,v);
  699. }
  700. static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
  701. {
  702. res->data = (char *)(nlSub((number)u->Data(), (number)v->Data()));
  703. return jjPLUSMINUS_Gen(res,u,v);
  704. }
  705. static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
  706. {
  707. res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
  708. return jjPLUSMINUS_Gen(res,u,v);
  709. }
  710. static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
  711. {
  712. res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
  713. return jjPLUSMINUS_Gen(res,u,v);
  714. }
  715. static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
  716. {
  717. res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
  718. if (res->data==NULL)
  719. {
  720. WerrorS("intmat size not compatible");
  721. return TRUE;
  722. }
  723. return jjPLUSMINUS_Gen(res,u,v);
  724. }
  725. static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
  726. {
  727. matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
  728. res->data = (char *)(mpSub(A , B));
  729. if (res->data==NULL)
  730. {
  731. Werror("matrix size not compatible(%dx%d, %dx%d)",
  732. MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
  733. return TRUE;
  734. }
  735. return jjPLUSMINUS_Gen(res,u,v);
  736. return FALSE;
  737. }
  738. static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
  739. {
  740. int a=(int)(long)u->Data();
  741. int b=(int)(long)v->Data();
  742. int c=a * b;
  743. if ((b!=0) && (c/b !=a))
  744. WarnS("int overflow(*), result may be wrong");
  745. res->data = (char *)((long)c);
  746. if ((u->Next()!=NULL) || (v->Next()!=NULL))
  747. return jjOP_REST(res,u,v);
  748. return FALSE;
  749. }
  750. static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
  751. {
  752. res->data = (char *)(nlMult( (number)u->Data(), (number)v->Data()));
  753. if ((v->next!=NULL) || (u->next!=NULL))
  754. return jjOP_REST(res,u,v);
  755. return FALSE;
  756. }
  757. static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
  758. {
  759. res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
  760. number n=(number)res->data;
  761. nNormalize(n);
  762. res->data=(char *)n;
  763. if ((v->next!=NULL) || (u->next!=NULL))
  764. return jjOP_REST(res,u,v);
  765. return FALSE;
  766. }
  767. static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
  768. {
  769. poly a;
  770. poly b;
  771. int dummy;
  772. if (v->next==NULL)
  773. {
  774. a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
  775. if (u->next==NULL)
  776. {
  777. b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
  778. if ((a!=NULL) && (b!=NULL)
  779. && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
  780. {
  781. Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
  782. pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
  783. pDelete(&a);
  784. pDelete(&b);
  785. return TRUE;
  786. }
  787. res->data = (char *)(pMult( a, b));
  788. pNormalize((poly)res->data);
  789. return FALSE;
  790. }
  791. // u->next exists: copy v
  792. b=pCopy((poly)v->Data());
  793. if ((a!=NULL) && (b!=NULL)
  794. && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
  795. {
  796. Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
  797. pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
  798. pDelete(&a);
  799. pDelete(&b);
  800. return TRUE;
  801. }
  802. res->data = (char *)(pMult( a, b));
  803. pNormalize((poly)res->data);
  804. return jjOP_REST(res,u,v);
  805. }
  806. // v->next exists: copy u
  807. a=pCopy((poly)u->Data());
  808. b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
  809. if ((a!=NULL) && (b!=NULL)
  810. && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
  811. {
  812. pDelete(&a);
  813. pDelete(&b);
  814. WerrorS("OVERFLOW");
  815. return TRUE;
  816. }
  817. res->data = (char *)(pMult( a, b));
  818. pNormalize((poly)res->data);
  819. return jjOP_REST(res,u,v);
  820. }
  821. static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
  822. {
  823. res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
  824. idNormalize((ideal)res->data);
  825. if ((v->next!=NULL) || (u->next!=NULL))
  826. return jjOP_REST(res,u,v);
  827. return FALSE;
  828. }
  829. static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
  830. {
  831. res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
  832. if (res->data==NULL)
  833. {
  834. WerrorS("intmat size not compatible");
  835. return TRUE;
  836. }
  837. if ((v->next!=NULL) || (u->next!=NULL))
  838. return jjOP_REST(res,u,v);
  839. return FALSE;
  840. }
  841. static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
  842. {
  843. number n=nInit_bigint((number)v->Data());
  844. poly p=pNSet(n);
  845. ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
  846. res->data = (char *)I;
  847. return FALSE;
  848. }
  849. static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
  850. {
  851. return jjTIMES_MA_BI1(res,v,u);
  852. }
  853. static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
  854. {
  855. poly p=(poly)v->CopyD(POLY_CMD);
  856. int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
  857. ideal I= (ideal)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
  858. if (r>0) I->rank=r;
  859. idNormalize(I);
  860. res->data = (char *)I;
  861. return FALSE;
  862. }
  863. static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
  864. {
  865. poly p=(poly)u->CopyD(POLY_CMD);
  866. int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
  867. ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD));
  868. if (r>0) I->rank=r;
  869. idNormalize(I);
  870. res->data = (char *)I;
  871. return FALSE;
  872. }
  873. static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
  874. {
  875. number n=(number)v->CopyD(NUMBER_CMD);
  876. poly p=pNSet(n);
  877. res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),p);
  878. idNormalize((ideal)res->data);
  879. return FALSE;
  880. }
  881. static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
  882. {
  883. return jjTIMES_MA_N1(res,v,u);
  884. }
  885. static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
  886. {
  887. res->data = (char *)mpMultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data());
  888. idNormalize((ideal)res->data);
  889. return FALSE;
  890. }
  891. static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
  892. {
  893. return jjTIMES_MA_I1(res,v,u);
  894. }
  895. static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
  896. {
  897. matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
  898. res->data = (char *)mpMult(A,B);
  899. if (res->data==NULL)
  900. {
  901. Werror("matrix size not compatible(%dx%d, %dx%d)",
  902. MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
  903. return TRUE;
  904. }
  905. idNormalize((ideal)res->data);
  906. if ((v->next!=NULL) || (u->next!=NULL))
  907. return jjOP_REST(res,u,v);
  908. return FALSE;
  909. }
  910. static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
  911. {
  912. number h=nlSub((number)u->Data(),(number)v->Data());
  913. res->data = (char *) (nlGreaterZero(h)||(nlIsZero(h)));
  914. nlDelete(&h,NULL);
  915. return FALSE;
  916. }
  917. static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
  918. {
  919. res->data = (char *)((int)((long)u->Data()) >= (int)((long)v->Data()));
  920. return FALSE;
  921. }
  922. static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
  923. {
  924. res->data = (char *) (nGreater((number)u->Data(),(number)v->Data())
  925. || nEqual((number)u->Data(),(number)v->Data()));
  926. return FALSE;
  927. }
  928. static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
  929. {
  930. number h=nlSub((number)u->Data(),(number)v->Data());
  931. res->data = (char *) (nlGreaterZero(h)&&(!nlIsZero(h)));
  932. nlDelete(&h,NULL);
  933. return FALSE;
  934. }
  935. static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
  936. {
  937. res->data = (char *)((int)((long)u->Data()) > (int)((long)v->Data()));
  938. return FALSE;
  939. }
  940. static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
  941. {
  942. res->data = (char *) (nGreater((number)u->Data(),(number)v->Data()));
  943. return FALSE;
  944. }
  945. static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
  946. {
  947. return jjGE_BI(res,v,u);
  948. }
  949. static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
  950. {
  951. res->data = (char *)((int)((long)u->Data()) <= (int)((long)v->Data()));
  952. return FALSE;
  953. }
  954. static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
  955. {
  956. return jjGE_N(res,v,u);
  957. }
  958. static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
  959. {
  960. return jjGT_BI(res,v,u);
  961. }
  962. static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
  963. {
  964. res->data = (char *)((int)((long)u->Data()) < (int)((long)v->Data()));
  965. return FALSE;
  966. }
  967. static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
  968. {
  969. return jjGT_N(res,v,u);
  970. }
  971. static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
  972. {
  973. if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
  974. int a= (int)(long)u->Data();
  975. int b= (int)(long)v->Data();
  976. if (b==0)
  977. {
  978. WerrorS(ii_div_by_0);
  979. return TRUE;
  980. }
  981. int bb=ABS(b);
  982. int c=a%bb;
  983. if(c<0) c+=bb;
  984. int r=0;
  985. switch (iiOp)
  986. {
  987. case INTMOD_CMD:
  988. r=c; break;
  989. case '%':
  990. r= (a % b); break;
  991. case INTDIV_CMD:
  992. r=((a-c) /b); break;
  993. case '/':
  994. r= (a / b); break;
  995. }
  996. res->data=(void *)((long)r);
  997. return FALSE;
  998. }
  999. static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
  1000. {
  1001. number q=(number)v->Data();
  1002. if (nlIsZero(q))
  1003. {
  1004. WerrorS(ii_div_by_0);
  1005. return TRUE;
  1006. }
  1007. q = nlIntDiv((number)u->Data(),q);
  1008. nlNormalize(q);
  1009. res->data = (char *)q;
  1010. return FALSE;
  1011. }
  1012. static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
  1013. {
  1014. number q=(number)v->Data();
  1015. if (nIsZero(q))
  1016. {
  1017. WerrorS(ii_div_by_0);
  1018. return TRUE;
  1019. }
  1020. q = nDiv((number)u->Data(),q);
  1021. nNormalize(q);
  1022. res->data = (char *)q;
  1023. return FALSE;
  1024. }
  1025. static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
  1026. {
  1027. poly q=(poly)v->Data();
  1028. if (q==NULL)
  1029. {
  1030. WerrorS(ii_div_by_0);
  1031. return TRUE;
  1032. }
  1033. poly p=(poly)(u->Data());
  1034. if (p==NULL)
  1035. {
  1036. res->data=NULL;
  1037. return FALSE;
  1038. }
  1039. if ((pNext(q)!=NULL) && (!rField_is_Ring()))
  1040. { /* This means that q != 0 consists of at least two terms.
  1041. Moreover, currRing is over a field. */
  1042. #ifdef HAVE_FACTORY
  1043. if(pGetComp(p)==0)
  1044. {
  1045. res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
  1046. q /*(poly)(v->Data())*/ ));
  1047. }
  1048. else
  1049. {
  1050. int comps=pMaxComp(p);
  1051. ideal I=idInit(comps,1);
  1052. p=pCopy(p);
  1053. poly h;
  1054. int i;
  1055. // conversion to a list of polys:
  1056. while (p!=NULL)
  1057. {
  1058. i=pGetComp(p)-1;
  1059. h=pNext(p);
  1060. pNext(p)=NULL;
  1061. pSetComp(p,0);
  1062. I->m[i]=pAdd(I->m[i],p);
  1063. p=h;
  1064. }
  1065. // division and conversion to vector:
  1066. h=NULL;
  1067. p=NULL;
  1068. for(i=comps-1;i>=0;i--)
  1069. {
  1070. if (I->m[i]!=NULL)
  1071. {
  1072. h=singclap_pdivide(I->m[i],q);
  1073. pSetCompP(h,i+1);
  1074. p=pAdd(p,h);
  1075. }
  1076. }
  1077. idDelete(&I);
  1078. res->data=(void *)p;
  1079. }
  1080. #else /* HAVE_FACTORY */
  1081. WerrorS("division only by a monomial");
  1082. return TRUE;
  1083. #endif /* HAVE_FACTORY */
  1084. }
  1085. else
  1086. { /* This means that q != 0 consists of just one term,
  1087. or that currRing is over a coefficient ring. */
  1088. #ifdef HAVE_RINGS
  1089. if (!rField_is_Domain())
  1090. {
  1091. WerrorS("division only defined over coefficient domains");
  1092. return TRUE;
  1093. }
  1094. if (pNext(q)!=NULL)
  1095. {
  1096. WerrorS("division over a coefficient domain only implemented for terms");
  1097. return TRUE;
  1098. }
  1099. #endif
  1100. res->data = (char *)pDivideM(pCopy(p),pHead(q));
  1101. }
  1102. pNormalize((poly)res->data);
  1103. return FALSE;
  1104. }
  1105. static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
  1106. {
  1107. poly q=(poly)v->Data();
  1108. if (q==NULL)
  1109. {
  1110. WerrorS(ii_div_by_0);
  1111. return TRUE;
  1112. }
  1113. matrix m=(matrix)(u->Data());
  1114. int r=m->rows();
  1115. int c=m->cols();
  1116. matrix mm=mpNew(r,c);
  1117. int i,j;
  1118. for(i=r;i>0;i--)
  1119. {
  1120. for(j=c;j>0;j--)
  1121. {
  1122. if (pNext(q)!=NULL)
  1123. {
  1124. #ifdef HAVE_FACTORY
  1125. MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
  1126. q /*(poly)(v->Data())*/ );
  1127. #else /* HAVE_FACTORY */
  1128. WerrorS("division only by a monomial");
  1129. return TRUE;
  1130. #endif /* HAVE_FACTORY */
  1131. }
  1132. else
  1133. MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
  1134. }
  1135. }
  1136. idNormalize((ideal)mm);
  1137. res->data=(char *)mm;
  1138. return FALSE;
  1139. }
  1140. static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
  1141. {
  1142. res->data = (char *)((long)nlEqual((number)u->Data(),(number)v->Data()));
  1143. jjEQUAL_REST(res,u,v);
  1144. return FALSE;
  1145. }
  1146. static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
  1147. {
  1148. res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
  1149. jjEQUAL_REST(res,u,v);
  1150. return FALSE;
  1151. }
  1152. static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
  1153. {
  1154. res->data = (char *)((long)mpEqual((matrix)u->Data(),(matrix)v->Data()));
  1155. jjEQUAL_REST(res,u,v);
  1156. return FALSE;
  1157. }
  1158. static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
  1159. {
  1160. res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
  1161. jjEQUAL_REST(res,u,v);
  1162. return FALSE;
  1163. }
  1164. static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
  1165. {
  1166. poly p=(poly)u->Data();
  1167. poly q=(poly)v->Data();
  1168. res->data = (char *) ((long)pEqualPolys(p,q));
  1169. jjEQUAL_REST(res,u,v);
  1170. return FALSE;
  1171. }
  1172. static void jjEQUAL_REST(leftv res,leftv u,leftv v)
  1173. {
  1174. if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
  1175. {
  1176. int save_iiOp=iiOp;
  1177. if (iiOp==NOTEQUAL)
  1178. iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
  1179. else
  1180. iiExprArith2(res,u->next,iiOp,v->next);
  1181. iiOp=save_iiOp;
  1182. }
  1183. if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
  1184. }
  1185. static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
  1186. {
  1187. res->data = (char *)((long)u->Data() && (long)v->Data());
  1188. return FALSE;
  1189. }
  1190. static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
  1191. {
  1192. res->data = (char *)((long)u->Data() || (long)v->Data());
  1193. return FALSE;
  1194. }
  1195. static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
  1196. {
  1197. res->rtyp=u->rtyp; u->rtyp=0;
  1198. res->data=u->data; u->data=NULL;
  1199. res->name=u->name; u->name=NULL;
  1200. res->e=u->e; u->e=NULL;
  1201. if (res->e==NULL) res->e=jjMakeSub(v);
  1202. else
  1203. {
  1204. Subexpr sh=res->e;
  1205. while (sh->next != NULL) sh=sh->next;
  1206. sh->next=jjMakeSub(v);
  1207. }
  1208. return FALSE;
  1209. }
  1210. static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
  1211. {
  1212. if ((u->rtyp!=IDHDL)||(u->e!=NULL))
  1213. {
  1214. WerrorS("indexed object must have a name");
  1215. return TRUE;
  1216. }
  1217. intvec * iv=(intvec *)v->Data();
  1218. leftv p=NULL;
  1219. int i;
  1220. sleftv t;
  1221. memset(&t,0,sizeof(t));
  1222. t.rtyp=INT_CMD;
  1223. for (i=0;i<iv->length(); i++)
  1224. {
  1225. t.data=(char *)((long)(*iv)[i]);
  1226. if (p==NULL)
  1227. {
  1228. p=res;
  1229. }
  1230. else
  1231. {
  1232. p->next=(leftv)omAlloc0Bin(sleftv_bin);
  1233. p=p->next;
  1234. }
  1235. p->rtyp=IDHDL;
  1236. p->data=u->data;
  1237. p->name=u->name;
  1238. p->flag=u->flag;
  1239. p->e=jjMakeSub(&t);
  1240. }
  1241. u->rtyp=0;
  1242. u->data=NULL;
  1243. u->name=NULL;
  1244. return FALSE;
  1245. }
  1246. static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
  1247. {
  1248. poly p=(poly)u->Data();
  1249. int i=(int)(long)v->Data();
  1250. int j=0;
  1251. while (p!=NULL)
  1252. {
  1253. j++;
  1254. if (j==i)
  1255. {
  1256. res->data=(char *)pHead(p);
  1257. return FALSE;
  1258. }
  1259. pIter(p);
  1260. }
  1261. return FALSE;
  1262. }
  1263. static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
  1264. {
  1265. poly p=(poly)u->Data();
  1266. poly r=NULL;
  1267. intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
  1268. int i;
  1269. int sum=0;
  1270. for(i=iv->length()-1;i>=0;i--)
  1271. sum+=(*iv)[i];
  1272. int j=0;
  1273. while ((p!=NULL) && (sum>0))
  1274. {
  1275. j++;
  1276. for(i=iv->length()-1;i>=0;i--)
  1277. {
  1278. if (j==(*iv)[i])
  1279. {
  1280. r=pAdd(r,pHead(p));
  1281. sum-=j;
  1282. (*iv)[i]=0;
  1283. break;
  1284. }
  1285. }
  1286. pIter(p);
  1287. }
  1288. delete iv;
  1289. res->data=(char *)r;
  1290. return FALSE;
  1291. }
  1292. static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
  1293. {
  1294. poly p=(poly)u->CopyD(VECTOR_CMD);
  1295. poly r=p; // pointer to the beginning of component i
  1296. poly o=NULL;
  1297. int i=(int)(long)v->Data();
  1298. while (p!=NULL)
  1299. {
  1300. if (pGetComp(p)!=i)
  1301. {
  1302. if (r==p) r=pNext(p);
  1303. if (o!=NULL)
  1304. {
  1305. if (pNext(o)!=NULL) pLmDelete(&pNext(o));
  1306. p=pNext(o);
  1307. }
  1308. else
  1309. pLmDelete(&p);
  1310. }
  1311. else
  1312. {
  1313. pSetComp(p, 0);
  1314. p_SetmComp(p, currRing);
  1315. o=p;
  1316. p=pNext(o);
  1317. }
  1318. }
  1319. res->data=(char *)r;
  1320. return FALSE;
  1321. }
  1322. static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
  1323. {
  1324. poly p=(poly)u->CopyD(VECTOR_CMD);
  1325. if (p!=NULL)
  1326. {
  1327. poly r=pOne();
  1328. poly hp=r;
  1329. intvec *iv=(intvec *)v->Data();
  1330. int i;
  1331. loop
  1332. {
  1333. for(i=0;i<iv->length();i++)
  1334. {
  1335. if (pGetComp(p)==(*iv)[i])
  1336. {
  1337. poly h;
  1338. pSplit(p,&h);
  1339. pNext(hp)=p;
  1340. p=h;
  1341. pIter(hp);
  1342. break;
  1343. }
  1344. }
  1345. if (p==NULL) break;
  1346. if (i==iv->length())
  1347. {
  1348. pLmDelete(&p);
  1349. if (p==NULL) break;
  1350. }
  1351. }
  1352. pLmDelete(&r);
  1353. res->data=(char *)r;
  1354. }
  1355. return FALSE;
  1356. }
  1357. static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
  1358. static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
  1359. {
  1360. if(u->name==NULL) return TRUE;
  1361. char * nn = (char *)omAlloc(strlen(u->name) + 14);
  1362. sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
  1363. omFree((ADDRESS)u->name);
  1364. u->name=NULL;
  1365. char *n=omStrDup(nn);
  1366. omFree((ADDRESS)nn);
  1367. syMake(res,n);
  1368. if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
  1369. return FALSE;
  1370. }
  1371. static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
  1372. {
  1373. intvec * iv=(intvec *)v->Data();
  1374. leftv p=NULL;
  1375. int i;
  1376. long slen = strlen(u->name) + 14;
  1377. char *n = (char*) omAlloc(slen);
  1378. for (i=0;i<iv->length(); i++)
  1379. {
  1380. if (p==NULL)
  1381. {
  1382. p=res;
  1383. }
  1384. else
  1385. {
  1386. p->next=(leftv)omAlloc0Bin(sleftv_bin);
  1387. p=p->next;
  1388. }
  1389. sprintf(n,"%s(%d)",u->name,(*iv)[i]);
  1390. syMake(p,omStrDup(n));
  1391. }
  1392. omFree((ADDRESS)u->name);
  1393. u->name = NULL;
  1394. omFreeSize(n, slen);
  1395. if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
  1396. return FALSE;
  1397. }
  1398. static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
  1399. {
  1400. leftv tmp=(leftv)omAllocBin(sleftv_bin);
  1401. memset(tmp,0,sizeof(sleftv));
  1402. BOOLEAN b;
  1403. if (v->Typ()==INTVEC_CMD)
  1404. b=jjKLAMMER_IV(tmp,u,v);
  1405. else
  1406. b=jjKLAMMER(tmp,u,v);
  1407. if (b)
  1408. {
  1409. omFreeBin(tmp,sleftv_bin);
  1410. return TRUE;
  1411. }
  1412. leftv h=res;
  1413. while (h->next!=NULL) h=h->next;
  1414. h->next=tmp;
  1415. return FALSE;
  1416. }
  1417. BOOLEAN jjPROC(leftv res, leftv u, leftv v)
  1418. {
  1419. void *d;
  1420. Subexpr e;
  1421. int typ;
  1422. BOOLEAN t=FALSE;
  1423. if ((u->rtyp!=IDHDL)||(u->e!=NULL))
  1424. {
  1425. idrec tmp_proc;
  1426. tmp_proc.id="_auto";
  1427. tmp_proc.typ=PROC_CMD;
  1428. tmp_proc.data.pinf=(procinfo *)u->Data();
  1429. tmp_proc.ref=1;
  1430. d=u->data; u->data=(void *)&tmp_proc;
  1431. e=u->e; u->e=NULL;
  1432. t=TRUE;
  1433. typ=u->rtyp; u->rtyp=IDHDL;
  1434. }
  1435. leftv sl;
  1436. if (u->req_packhdl==currPack)
  1437. sl = iiMake_proc((idhdl)u->data,NULL,v);
  1438. else
  1439. sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
  1440. if (t)
  1441. {
  1442. u->rtyp=typ;
  1443. u->data=d;
  1444. u->e=e;
  1445. }
  1446. if (sl==NULL)
  1447. {
  1448. return TRUE;
  1449. }
  1450. else
  1451. {
  1452. memcpy(res,sl,sizeof(sleftv));
  1453. }
  1454. return FALSE;
  1455. }
  1456. static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
  1457. {
  1458. //Print("try to map %s with %s\n",$3.Name(),$1.Name());
  1459. leftv sl=NULL;
  1460. if ((v->e==NULL)&&(v->name!=NULL))
  1461. {
  1462. map m=(map)u->Data();
  1463. sl=iiMap(m,v->name);
  1464. }
  1465. else
  1466. {
  1467. Werror("%s(<name>) expected",u->Name());
  1468. }
  1469. if (sl==NULL) return TRUE;
  1470. memcpy(res,sl,sizeof(sleftv));
  1471. omFreeBin((ADDRESS)sl, sleftv_bin);
  1472. return FALSE;
  1473. }
  1474. static BOOLEAN jjCALL2MANY(leftv res, leftv u, leftv v)
  1475. {
  1476. u->next=(leftv)omAllocBin(sleftv_bin);
  1477. memcpy(u->next,v,sizeof(sleftv));
  1478. BOOLEAN r=iiExprArithM(res,u,iiOp);
  1479. v->Init();
  1480. // iiExprArithM did the CleanUp
  1481. return r;
  1482. }
  1483. #ifdef HAVE_FACTORY
  1484. static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
  1485. {
  1486. intvec *c=(intvec*)u->Data();
  1487. intvec* p=(intvec*)v->Data();
  1488. int rl=p->length();
  1489. number *x=(number *)omAlloc(rl*sizeof(number));
  1490. number *q=(number *)omAlloc(rl*sizeof(number));
  1491. int i;
  1492. for(i=rl-1;i>=0;i--)
  1493. {
  1494. q[i]=nlInit((*p)[i], NULL);
  1495. x[i]=nlInit((*c)[i], NULL);
  1496. }
  1497. number n=nlChineseRemainder(x,q,rl);
  1498. for(i=rl-1;i>=0;i--)
  1499. {
  1500. nlDelete(&(q[i]),NULL);
  1501. nlDelete(&(x[i]),NULL);
  1502. }
  1503. omFree(x); omFree(q);
  1504. res->data=(char *)n;
  1505. return FALSE;
  1506. }
  1507. #endif
  1508. #if 0
  1509. static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
  1510. {
  1511. lists c=(lists)u->CopyD(); // list of poly
  1512. intvec* p=(intvec*)v->Data();
  1513. int rl=p->length();
  1514. poly r=NULL,h, result=NULL;
  1515. number *x=(number *)omAlloc(rl*sizeof(number));
  1516. number *q=(number *)omAlloc(rl*sizeof(number));
  1517. int i;
  1518. for(i=rl-1;i>=0;i--)
  1519. {
  1520. q[i]=nlInit((*p)[i]);
  1521. }
  1522. loop
  1523. {
  1524. for(i=rl-1;i>=0;i--)
  1525. {
  1526. if (c->m[i].Typ()!=POLY_CMD)
  1527. {
  1528. Werror("poly expected at pos %d",i+1);
  1529. for(i=rl-1;i>=0;i--)
  1530. {
  1531. nlDelete(&(q[i]),currRing);
  1532. }
  1533. omFree(x); omFree(q); // delete c
  1534. return TRUE;
  1535. }
  1536. h=((poly)c->m[i].Data());
  1537. if (r==NULL) r=h;
  1538. else if (pLmCmp(r,h)==-1) r=h;
  1539. }
  1540. if (r==NULL) break;
  1541. for(i=rl-1;i>=0;i--)
  1542. {
  1543. h=((poly)c->m[i].Data());
  1544. if (pLmCmp(r,h)==0)
  1545. {
  1546. x[i]=pGetCoeff(h);
  1547. h=pLmFreeAndNext(h);
  1548. c->m[i].data=(char*)h;
  1549. }
  1550. else
  1551. x[i]=nlInit(0);
  1552. }
  1553. number n=nlChineseRemainder(x,q,rl);
  1554. for(i=rl-1;i>=0;i--)
  1555. {
  1556. nlDelete(&(x[i]),currRing);
  1557. }
  1558. h=pHead(r);
  1559. pSetCoeff(h,n);
  1560. result=pAdd(result,h);
  1561. }
  1562. for(i=rl-1;i>=0;i--)
  1563. {
  1564. nlDelete(&(q[i]),currRing);
  1565. }
  1566. omFree(x); omFree(q);
  1567. res->data=(char *)result;
  1568. return FALSE;
  1569. }
  1570. #endif
  1571. #ifdef HAVE_FACTORY
  1572. static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
  1573. {
  1574. if ((currRing==NULL) || rField_is_Q())
  1575. {
  1576. lists c=(lists)u->CopyD(); // list of ideal
  1577. lists pl=NULL;
  1578. intvec *p=NULL;
  1579. if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
  1580. else p=(intvec*)v->Data();
  1581. int rl=c->nr+1;
  1582. poly r=NULL,h;
  1583. ideal result;
  1584. ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
  1585. int i;
  1586. int return_type=c->m[0].Typ();
  1587. if ((return_type!=IDEAL_CMD)
  1588. && (return_type!=MODUL_CMD)
  1589. && (return_type!=MATRIX_CMD))
  1590. {
  1591. WerrorS("ideal/module/matrix expected");
  1592. omFree(x); // delete c
  1593. return TRUE;
  1594. }
  1595. for(i=rl-1;i>=0;i--)
  1596. {
  1597. if (c->m[i].Typ()!=return_type)
  1598. {
  1599. Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
  1600. omFree(x); // delete c
  1601. return TRUE;
  1602. }
  1603. x[i]=((ideal)c->m[i].Data());
  1604. }
  1605. number *q=(number *)omAlloc(rl*sizeof(number));
  1606. if (p!=NULL)
  1607. {
  1608. for(i=rl-1;i>=0;i--)
  1609. {
  1610. q[i]=nlInit((*p)[i], currRing);
  1611. }
  1612. }
  1613. else
  1614. {
  1615. for(i=rl-1;i>=0;i--)
  1616. {
  1617. if (pl->m[i].Typ()==INT_CMD)
  1618. {
  1619. q[i]=nlInit((int)(long)pl->m[i].Data(),currRing);
  1620. }
  1621. else if (pl->m[i].Typ()==BIGINT_CMD)
  1622. {
  1623. q[i]=nlCopy((number)(pl->m[i].Data()));
  1624. }
  1625. else
  1626. {
  1627. Werror("bigint expected at pos %d",i+1);
  1628. for(i++;i<rl;i++)
  1629. {
  1630. nlDelete(&(q[i]),currRing);
  1631. }
  1632. omFree(x); // delete c
  1633. omFree(q); // delete pl
  1634. return TRUE;
  1635. }
  1636. }
  1637. }
  1638. result=idChineseRemainder(x,q,rl);
  1639. for(i=rl-1;i>=0;i--)
  1640. {
  1641. nlDelete(&(q[i]),currRing);
  1642. }
  1643. omFree(q);
  1644. res->data=(char *)result;
  1645. res->rtyp=return_type;
  1646. return FALSE;
  1647. }
  1648. else return TRUE;
  1649. }
  1650. #endif
  1651. static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
  1652. {
  1653. poly p=(poly)v->Data();
  1654. if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
  1655. res->data=(char *)mpCoeffProc((poly)u->Data(),p /*(poly)v->Data()*/);
  1656. return FALSE;
  1657. }
  1658. static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
  1659. {
  1660. int i=pVar((poly)v->Data());
  1661. if (i==0)
  1662. {
  1663. WerrorS("ringvar expected");
  1664. return TRUE;
  1665. }
  1666. res->data=(char *)mpCoeffs((ideal)u->CopyD(),i);
  1667. return FALSE;
  1668. }
  1669. static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
  1670. {
  1671. poly p = pInit();
  1672. int i;
  1673. for (i=1; i<=pVariables; i++)
  1674. {
  1675. pSetExp(p, i, 1);
  1676. }
  1677. pSetm(p);
  1678. res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
  1679. (ideal)(v->Data()), p);
  1680. pDelete(&p);
  1681. return FALSE;
  1682. }
  1683. static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
  1684. {
  1685. res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
  1686. return FALSE;
  1687. }
  1688. static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
  1689. {
  1690. short *iv=iv2array((intvec *)v->Data());
  1691. ideal I=(ideal)u->Data();
  1692. int d=-1;
  1693. int i;
  1694. for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
  1695. omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
  1696. res->data = (char *)((long)d);
  1697. return FALSE;
  1698. }
  1699. static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
  1700. {
  1701. poly p=(poly)u->Data();
  1702. if (p!=NULL)
  1703. {
  1704. short *iv=iv2array((intvec *)v->Data());
  1705. int d=(int)pDegW(p,iv);
  1706. omFreeSize((ADDRESS)iv,(pVariables+1)*sizeof(short));
  1707. res->data = (char *)(long(d));
  1708. }
  1709. else
  1710. res->data=(char *)(long)(-1);
  1711. return FALSE;
  1712. }
  1713. static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
  1714. {
  1715. int i=pVar((poly)v->Data());
  1716. if (i==0)
  1717. {
  1718. WerrorS("ringvar expected");
  1719. return TRUE;
  1720. }
  1721. res->data=(char *)pDiff((poly)(u->Data()),i);
  1722. return FALSE;
  1723. }
  1724. static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
  1725. {
  1726. int i=pVar((poly)v->Data());
  1727. if (i==0)
  1728. {
  1729. WerrorS("ringvar expected");
  1730. return TRUE;
  1731. }
  1732. res->data=(char *)idDiff((matrix)(u->Data()),i);
  1733. return FALSE;
  1734. }
  1735. static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
  1736. {
  1737. res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
  1738. return FALSE;
  1739. }
  1740. static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
  1741. {
  1742. assumeStdFlag(v);
  1743. #ifdef HAVE_RINGS
  1744. if (rField_is_Ring(currRing))
  1745. {
  1746. ring origR = currRing;
  1747. ring tempR = rCopy(origR);
  1748. tempR->ringtype = 0; tempR->ch = 0;
  1749. rComplete(tempR);
  1750. ideal vid = (ideal)v->Data();
  1751. int i = idPosConstant(vid);
  1752. if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
  1753. { /* ideal v contains unit; dim = -1 */
  1754. res->data = (char *)-1;
  1755. return FALSE;
  1756. }
  1757. rChangeCurrRing(tempR);
  1758. ideal vv = idrCopyR(vid, origR, currRing);
  1759. ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
  1760. /* drop degree zero generator from vv (if any) */
  1761. if (i != -1) pDelete(&vv->m[i]);
  1762. long d = (long)scDimInt(vv, ww);
  1763. if (rField_is_Ring_Z(origR) && (i == -1)) d++;
  1764. res->data = (char *)d;
  1765. idDelete(&vv); idDelete(&ww);
  1766. rChangeCurrRing(origR);
  1767. rDelete(tempR);
  1768. return FALSE;
  1769. }
  1770. #endif
  1771. if(currQuotient==NULL)
  1772. res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
  1773. else
  1774. {
  1775. ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
  1776. res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
  1777. idDelete(&q);
  1778. }
  1779. return FALSE;
  1780. }
  1781. static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
  1782. {
  1783. ideal vi=(ideal)v->Data();
  1784. int vl= IDELEMS(vi);
  1785. ideal ui=(ideal)u->Data();
  1786. int ul= IDELEMS(ui);
  1787. ideal R; matrix U;
  1788. ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
  1789. // now make sure that all matices have the corect size:
  1790. matrix T = idModule2formatedMatrix(m,vl,ul);
  1791. int i;
  1792. if (MATCOLS(U) != ul)
  1793. {
  1794. int mul=si_min(ul,MATCOLS(U));
  1795. matrix UU=mpNew(ul,ul);
  1796. int j;
  1797. for(i=mul;i>0;i--)
  1798. {
  1799. for(j=mul;j>0;j--)
  1800. {
  1801. MATELEM(UU,i,j)=MATELEM(U,i,j);
  1802. MATELEM(U,i,j)=NULL;
  1803. }
  1804. }
  1805. idDelete((ideal *)&U);
  1806. U=UU;
  1807. }
  1808. // make sure that U is a diagonal matrix of units
  1809. for(i=ul;i>0;i--)
  1810. {
  1811. if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
  1812. }
  1813. lists L=(lists)omAllocBin(slists_bin);
  1814. L->Init(3);
  1815. L->m[0].rtyp=MATRIX_CMD; L->m[0].data=(void *)T;
  1816. L->m[1].rtyp=u->Typ(); L->m[1].data=(void *)R;
  1817. L->m[2].rtyp=MATRIX_CMD; L->m[2].data=(void *)U;
  1818. res->data=(char *)L;
  1819. return FALSE;
  1820. }
  1821. static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
  1822. {
  1823. res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
  1824. //setFlag(res,FLAG_STD);
  1825. return FALSE;
  1826. }
  1827. static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
  1828. {
  1829. poly p=pOne();
  1830. intvec *iv=(intvec*)v->Data();
  1831. for(int i=iv->length()-1; i>=0; i--)
  1832. {
  1833. pSetExp(p,(*iv)[i],1);
  1834. }
  1835. pSetm(p);
  1836. res->data=(char *)idElimination((ideal)u->Data(),p);
  1837. pLmDelete(&p);
  1838. //setFlag(res,FLAG_STD);
  1839. return FALSE;
  1840. }
  1841. static BOOLEAN jjEXPORTTO(leftv res, leftv u, leftv v)
  1842. {
  1843. //Print("exportto %s -> %s\n",v->Name(),u->Name() );
  1844. return iiExport(v,0,(idhdl)u->data);
  1845. }
  1846. static BOOLEAN jjERROR(leftv res, leftv u)
  1847. {
  1848. WerrorS((char *)u->Data());
  1849. extern int inerror;
  1850. inerror=3;
  1851. return TRUE;
  1852. }
  1853. static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
  1854. {
  1855. int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
  1856. int p0=ABS(uu),p1=ABS(vv);
  1857. int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
  1858. while ( p1!=0 )
  1859. {
  1860. q=p0 / p1;
  1861. r=p0 % p1;
  1862. p0 = p1; p1 = r;
  1863. r = g0 - g1 * q;
  1864. g0 = g1; g1 = r;
  1865. r = f0 - f1 * q;
  1866. f0 = f1; f1 = r;
  1867. }
  1868. int a = f0;
  1869. int b = g0;
  1870. if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
  1871. if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
  1872. lists L=(lists)omAllocBin(slists_bin);
  1873. L->Init(3);
  1874. L->m[0].rtyp=INT_CMD; L->m[0].data=(void *)(long)p0;
  1875. L->m[1].rtyp=INT_CMD; L->m[1].data=(void *)(long)a;
  1876. L->m[2].rtyp=INT_CMD; L->m[2].data=(void *)(long)b;
  1877. res->rtyp=LIST_CMD;
  1878. res->data=(char *)L;
  1879. return FALSE;
  1880. }
  1881. #ifdef HAVE_FACTORY
  1882. static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
  1883. {
  1884. poly r,pa,pb;
  1885. BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb);
  1886. if (ret) return TRUE;
  1887. lists L=(lists)omAllocBin(slists_bin);
  1888. L->Init(3);
  1889. res->data=(char *)L;
  1890. L->m[0].data=(void *)r;
  1891. L->m[0].rtyp=POLY_CMD;
  1892. L->m[1].data=(void *)pa;
  1893. L->m[1].rtyp=POLY_CMD;
  1894. L->m[2].data=(void *)pb;
  1895. L->m[2].rtyp=POLY_CMD;
  1896. return FALSE;
  1897. }
  1898. extern int singclap_factorize_retry;
  1899. static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
  1900. {
  1901. intvec *v=NULL;
  1902. int sw=(int)(long)dummy->Data();
  1903. int fac_sw=sw;
  1904. if ((sw<0)||(sw>2)) fac_sw=1;
  1905. singclap_factorize_retry=0;
  1906. ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw);
  1907. if (f==NULL)
  1908. return TRUE;
  1909. switch(sw)
  1910. {
  1911. case 0:
  1912. case 2:
  1913. {
  1914. lists l=(lists)omAllocBin(slists_bin);
  1915. l->Init(2);
  1916. l->m[0].rtyp=IDEAL_CMD;
  1917. l->m[0].data=(void *)f;
  1918. l->m[1].rtyp=INTVEC_CMD;
  1919. l->m[1].data=(void *)v;
  1920. res->data=(void *)l;
  1921. res->rtyp=LIST_CMD;
  1922. return FALSE;
  1923. }
  1924. case 1:
  1925. res->data=(void *)f;
  1926. return FALSE;
  1927. case 3:
  1928. {
  1929. poly p=f->m[0];
  1930. int i=IDELEMS(f);
  1931. f->m[0]=NULL;
  1932. while(i>1)
  1933. {
  1934. i--;
  1935. p=pMult(p,f->m[i]);
  1936. f->m[i]=NULL;
  1937. }
  1938. res->data=(void *)p;
  1939. res->rtyp=POLY_CMD;
  1940. }
  1941. return FALSE;
  1942. }
  1943. WerrorS("invalid switch");
  1944. return TRUE;
  1945. }
  1946. static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
  1947. {
  1948. ideal_list p,h;
  1949. h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
  1950. p=h;
  1951. int l=0;
  1952. while (p!=NULL) { p=p->next;l++; }
  1953. lists L=(lists)omAllocBin(slists_bin);
  1954. L->Init(l);
  1955. l=0;
  1956. while(h!=NULL)
  1957. {
  1958. L->m[l].data=(char *)h->d;
  1959. L->m[l].rtyp=IDEAL_CMD;
  1960. p=h->next;
  1961. omFreeSize(h,sizeof(*h));
  1962. h=p;
  1963. l++;
  1964. }
  1965. res->data=(void *)L;
  1966. return FALSE;
  1967. }
  1968. #endif /* HAVE_FACTORY */
  1969. static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
  1970. {
  1971. if (rField_is_Q())
  1972. {
  1973. number uu=(number)u->Data();
  1974. number vv=(number)v->Data();
  1975. res->data=(char *)nlFarey(uu,vv);
  1976. return FALSE;
  1977. }
  1978. else return TRUE;
  1979. }
  1980. static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
  1981. {
  1982. if (rField_is_Q())
  1983. {
  1984. ideal uu=(ideal)u->Data();
  1985. number vv=(number)v->Data();
  1986. res->data=(void*)idFarey(uu,vv);
  1987. res->rtyp=u->Typ();
  1988. return FALSE;
  1989. }
  1990. else return TRUE;
  1991. }
  1992. static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
  1993. {
  1994. ring r=(ring)u->Data();
  1995. idhdl w;
  1996. int op=iiOp;
  1997. nMapFunc nMap;
  1998. if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
  1999. {
  2000. int *perm=NULL;
  2001. int *par_perm=NULL;
  2002. int par_perm_size=0;
  2003. BOOLEAN bo;
  2004. //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
  2005. if ((nMap=nSetMap(r))==NULL)
  2006. {
  2007. if (rEqual(r,currRing))
  2008. {
  2009. nMap=nCopy;
  2010. }
  2011. else
  2012. // Allow imap/fetch to be make an exception only for:
  2013. if ( (rField_is_Q_a(r) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
  2014. (rField_is_Q() || rField_is_Q_a() ||
  2015. (rField_is_Zp() || rField_is_Zp_a())))
  2016. ||
  2017. (rField_is_Zp_a(r) && // Zp(a..) -> Zp(a..) || Zp
  2018. (rField_is_Zp(currRing, rInternalChar(r)) ||
  2019. rField_is_Zp_a(currRing, rInternalChar(r)))) )
  2020. {
  2021. par_perm_size=rPar(r);
  2022. BITSET save_test=test;
  2023. if ((r->minpoly != NULL) || (r->minideal != NULL))
  2024. naSetChar(rInternalChar(r),r);
  2025. else ntSetChar(rInternalChar(r),r);
  2026. nSetChar(currRing);
  2027. test=save_test;
  2028. }
  2029. else
  2030. {
  2031. goto err_fetch;
  2032. }
  2033. }
  2034. if ((iiOp!=FETCH_CMD) || (r->N!=pVariables) || (rPar(r)!=rPar(currRing)))
  2035. {
  2036. perm=(int *)omAlloc0((r->N+1)*sizeof(int));
  2037. if (par_perm_size!=0)
  2038. par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
  2039. op=IMAP_CMD;
  2040. if (iiOp==IMAP_CMD)
  2041. {
  2042. maFindPerm(r->names, r->N, r->parameter, r->P,
  2043. currRing->names,currRing->N,currRing->parameter, currRing->P,
  2044. perm,par_perm, currRing->ch);
  2045. }
  2046. else
  2047. {
  2048. int i;
  2049. if (par_perm_size!=0)
  2050. for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
  2051. for(i=si_min(r->N,pVariables);i>0;i--) perm[i]=i;
  2052. }
  2053. }
  2054. if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
  2055. {
  2056. int i;
  2057. for(i=0;i<si_min(r->N,pVariables);i++)
  2058. {
  2059. Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
  2060. }
  2061. for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
  2062. {
  2063. Print("// par nr %d: %s -> %s\n",
  2064. i,r->parameter[i],currRing->parameter[i]);
  2065. }
  2066. }
  2067. sleftv tmpW;
  2068. memset(&tmpW,0,sizeof(sleftv));
  2069. tmpW.rtyp=IDTYP(w);
  2070. tmpW.data=IDDATA(w);
  2071. if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
  2072. perm,par_perm,par_perm_size,nMap)))
  2073. {
  2074. Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
  2075. }
  2076. if (perm!=NULL)
  2077. omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
  2078. if (par_perm!=NULL)
  2079. omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
  2080. return bo;
  2081. }
  2082. else
  2083. {
  2084. Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
  2085. }
  2086. return TRUE;
  2087. err_fetch:
  2088. Werror("no identity map from %s",u->Fullname());
  2089. return TRUE;
  2090. }
  2091. static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
  2092. {
  2093. /*4
  2094. * look for the substring what in the string where
  2095. * return the position of the first char of what in where
  2096. * or 0
  2097. */
  2098. char *where=(char *)u->Data();
  2099. char *what=(char *)v->Data();
  2100. char *found = strstr(where,what);
  2101. if (found != NULL)
  2102. {
  2103. res->data=(char *)((found-where)+1);
  2104. }
  2105. /*else res->data=NULL;*/
  2106. return FALSE;
  2107. }
  2108. static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
  2109. {
  2110. res->data=(char *)fractalWalkProc(u,v);
  2111. setFlag( res, FLAG_STD );
  2112. return FALSE;
  2113. }
  2114. static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
  2115. {
  2116. int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
  2117. int p0=ABS(uu),p1=ABS(vv);
  2118. int r;
  2119. while ( p1!=0 )
  2120. {
  2121. r=p0 % p1;
  2122. p0 = p1; p1 = r;
  2123. }
  2124. res->rtyp=INT_CMD;
  2125. res->data=(char *)(long)p0;
  2126. return FALSE;
  2127. }
  2128. static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
  2129. {
  2130. number a=(number) u->Data();
  2131. number b=(number) v->Data();
  2132. if (nlIsZero(a))
  2133. {
  2134. if (nlIsZero(b)) res->data=(char *)nlInit(1, NULL);
  2135. else res->data=(char *)nlCopy(b);
  2136. }
  2137. else
  2138. {
  2139. if (nlIsZero(b)) res->data=(char *)nlCopy(a);
  2140. else res->data=(char *)nlGcd(a, b, NULL);
  2141. }
  2142. return FALSE;
  2143. }
  2144. static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
  2145. {
  2146. number a=(number) u->Data();
  2147. number b=(number) v->Data();
  2148. if (nIsZero(a))
  2149. {
  2150. if (nIsZero(b)) res->data=(char *)nInit(1);
  2151. else res->data=(char *)nCopy(b);
  2152. }
  2153. else
  2154. {
  2155. if (nIsZero(b)) res->data=(char *)nCopy(a);
  2156. else res->data=(char *)nGcd(a, b, currRing);
  2157. }
  2158. return FALSE;
  2159. }
  2160. #ifdef HAVE_FACTORY
  2161. static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
  2162. {
  2163. res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
  2164. (poly)(v->CopyD(POLY_CMD)));
  2165. return FALSE;
  2166. }
  2167. #endif /* HAVE_FACTORY */
  2168. static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
  2169. {
  2170. #ifdef HAVE_RINGS
  2171. if (rField_is_Ring_Z(currRing))
  2172. {
  2173. ring origR = currRing;
  2174. ring tempR = rCopy(origR);
  2175. tempR->ringtype = 0; tempR->ch = 0;
  2176. rComplete(tempR);
  2177. ideal uid = (ideal)u->Data();
  2178. rChangeCurrRing(tempR);
  2179. ideal uu = idrCopyR(uid, origR, currRing);
  2180. sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
  2181. uuAsLeftv.rtyp = IDEAL_CMD;
  2182. uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
  2183. if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
  2184. assumeStdFlag(&uuAsLeftv);
  2185. Print("// NOTE: computation of Hilbert series etc. is being\n");
  2186. Print("// performed for generic fibre, that is, over Q\n");
  2187. intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
  2188. intvec *iv=hFirstSeries(uu,module_w,currQuotient);
  2189. int returnWithTrue = 1;
  2190. switch((int)(long)v->Data())
  2191. {
  2192. case 1:
  2193. res->data=(void *)iv;
  2194. returnWithTrue = 0;
  2195. case 2:
  2196. res->data=(void *)hSecondSeries(iv);
  2197. delete iv;
  2198. returnWithTrue = 0;
  2199. }
  2200. if (returnWithTrue)
  2201. {
  2202. WerrorS(feNotImplemented);
  2203. delete iv;
  2204. }
  2205. idDelete(&uu);
  2206. rChangeCurrRing(origR);
  2207. rDelete(tempR);
  2208. if (returnWithTrue) return TRUE; else return FALSE;
  2209. }
  2210. #endif
  2211. assumeStdFlag(u);
  2212. intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
  2213. intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
  2214. switch((int)(long)v->Data())
  2215. {
  2216. case 1:
  2217. res->data=(void *)iv;
  2218. return FALSE;
  2219. case 2:
  2220. res->data=(void *)hSecondSeries(iv);
  2221. delete iv;
  2222. return FALSE;
  2223. }
  2224. WerrorS(feNotImplemented);
  2225. delete iv;
  2226. return TRUE;
  2227. }
  2228. static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
  2229. {
  2230. int i=pVar((poly)v->Data());
  2231. if (i==0)
  2232. {
  2233. WerrorS("ringvar expected");
  2234. return TRUE;
  2235. }
  2236. poly p=pOne(); pSetExp(p,i,1); pSetm(p);
  2237. int d=pWTotaldegree(p);
  2238. pLmDelete(p);
  2239. if (d==1)
  2240. res->data = (char *)pHomogen((poly)u->Data(),i);
  2241. else
  2242. WerrorS("variable must have weight 1");
  2243. return (d!=1);
  2244. }
  2245. static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
  2246. {
  2247. int i=pVar((poly)v->Data());
  2248. if (i==0)
  2249. {
  2250. WerrorS("ringvar expected");
  2251. return TRUE;
  2252. }
  2253. pFDegProc deg;
  2254. if (pLexOrder && (currRing->order[0]==ringorder_lp))
  2255. deg=p_Totaldegree;
  2256. else
  2257. deg=pFDeg;
  2258. poly p=pOne(); pSetExp(p,i,1); pSetm(p);
  2259. int d=deg(p,currRing);
  2260. pLmDelete(p);
  2261. if (d==1)
  2262. res->data = (char *)idHomogen((ideal)u->Data(),i);
  2263. else
  2264. WerrorS("variable must have weight 1");
  2265. return (d!=1);
  2266. }
  2267. static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
  2268. {
  2269. intvec *w=new intvec(rVar(currRing));
  2270. intvec *vw=(intvec*)u->Data();
  2271. ideal v_id=(ideal)v->Data();
  2272. pFDegProc save_FDeg=pFDeg;
  2273. pLDegProc save_LDeg=pLDeg;
  2274. BOOLEAN save_pLexOrder=pLexOrder;
  2275. pLexOrder=FALSE;
  2276. kHomW=vw;
  2277. kModW=w;
  2278. pSetDegProcs(kHomModDeg);
  2279. res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
  2280. pLexOrder=save_pLexOrder;
  2281. kHomW=NULL;
  2282. kModW=NULL;
  2283. pRestoreDegProcs(save_FDeg,save_LDeg);
  2284. if (w!=NULL) delete w;
  2285. return FALSE;
  2286. }
  2287. static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
  2288. {
  2289. assumeStdFlag(u);
  2290. res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
  2291. currQuotient);
  2292. return FALSE;
  2293. }
  2294. static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
  2295. {
  2296. res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
  2297. setFlag(res,FLAG_STD);
  2298. return FALSE;
  2299. }
  2300. static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
  2301. {
  2302. return jjStdJanetBasis(res,u,(int)(long)v->Data());
  2303. }
  2304. static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
  2305. {
  2306. res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
  2307. return FALSE;
  2308. }
  2309. static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
  2310. {
  2311. res->data = (char *)idJet((ideal)u->Data(),(int)(long)v->Data());
  2312. return FALSE;
  2313. }
  2314. static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
  2315. {
  2316. assumeStdFlag(u);
  2317. intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  2318. res->data = (char *)scKBase((int)(long)v->Data(),
  2319. (ideal)(u->Data()),currQuotient, w_u);
  2320. if (w_u!=NULL)
  2321. {
  2322. atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
  2323. }
  2324. return FALSE;
  2325. }
  2326. static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
  2327. static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
  2328. {
  2329. return jjPREIMAGE(res,u,v,NULL);
  2330. }
  2331. static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
  2332. {
  2333. return mpKoszul(res, u,v);
  2334. }
  2335. static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
  2336. {
  2337. sleftv h;
  2338. memset(&h,0,sizeof(sleftv));
  2339. h.rtyp=INT_CMD;
  2340. h.data=(void *)(long)IDELEMS((ideal)v->Data());
  2341. return mpKoszul(res, u, &h, v);
  2342. }
  2343. static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
  2344. {
  2345. ideal m;
  2346. BITSET save_test=test;
  2347. int ul= IDELEMS((ideal)u->Data());
  2348. int vl= IDELEMS((ideal)v->Data());
  2349. m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD));
  2350. res->data = (char *)idModule2formatedMatrix(m,ul,vl);
  2351. test=save_test;
  2352. return FALSE;
  2353. }
  2354. static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
  2355. {
  2356. if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
  2357. idhdl h=(idhdl)v->data;
  2358. // CopyD for IDEAL_CMD and MODUL_CMD are identical:
  2359. res->data = (char *)idLiftStd((ideal)u->Data(),
  2360. &(h->data.umatrix),testHomog);
  2361. setFlag(res,FLAG_STD); v->flag=0;
  2362. return FALSE;
  2363. }
  2364. static BOOLEAN jjLOAD2(leftv res, leftv u,leftv v)
  2365. {
  2366. return jjLOAD(res, v,TRUE);
  2367. }
  2368. static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
  2369. {
  2370. char * s=(char *)u->Data();
  2371. if(strcmp(s, "with")==0)
  2372. return jjLOAD(res, v, TRUE);
  2373. WerrorS("invalid second argument");
  2374. WerrorS("load(\"libname\" [,\"with\"]);");
  2375. return TRUE;
  2376. }
  2377. static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
  2378. {
  2379. intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  2380. tHomog hom=testHomog;
  2381. if (w_u!=NULL)
  2382. {
  2383. w_u=ivCopy(w_u);
  2384. hom=isHomog;
  2385. }
  2386. intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
  2387. if (w_v!=NULL)
  2388. {
  2389. w_v=ivCopy(w_v);
  2390. hom=isHomog;
  2391. }
  2392. if ((w_u!=NULL) && (w_v==NULL))
  2393. w_v=ivCopy(w_u);
  2394. if ((w_v!=NULL) && (w_u==NULL))
  2395. w_u=ivCopy(w_v);
  2396. ideal u_id=(ideal)u->Data();
  2397. ideal v_id=(ideal)v->Data();
  2398. if (w_u!=NULL)
  2399. {
  2400. if ((*w_u).compare((w_v))!=0)
  2401. {
  2402. WarnS("incompatible weights");
  2403. delete w_u; w_u=NULL;
  2404. hom=testHomog;
  2405. }
  2406. else
  2407. {
  2408. if ((!idTestHomModule(u_id,currQuotient,w_v))
  2409. || (!idTestHomModule(v_id,currQuotient,w_v)))
  2410. {
  2411. WarnS("wrong weights");
  2412. delete w_u; w_u=NULL;
  2413. hom=testHomog;
  2414. }
  2415. }
  2416. }
  2417. res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
  2418. if (w_u!=NULL)
  2419. {
  2420. atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
  2421. }
  2422. delete w_v;
  2423. return FALSE;
  2424. }
  2425. static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
  2426. {
  2427. number q=(number)v->Data();
  2428. if (nlIsZero(q))
  2429. {
  2430. WerrorS(ii_div_by_0);
  2431. return TRUE;
  2432. }
  2433. res->data =(char *) nlIntMod((number)u->Data(),q);
  2434. return FALSE;
  2435. }
  2436. static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
  2437. {
  2438. number q=(number)v->Data();
  2439. if (nIsZero(q))
  2440. {
  2441. WerrorS(ii_div_by_0);
  2442. return TRUE;
  2443. }
  2444. res->data =(char *) nIntMod((number)u->Data(),q);
  2445. return FALSE;
  2446. }
  2447. static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
  2448. static BOOLEAN jjMONITOR1(leftv res, leftv v)
  2449. {
  2450. return jjMONITOR2(res,v,NULL);
  2451. }
  2452. static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v)
  2453. {
  2454. #if 0
  2455. char *opt=(char *)v->Data();
  2456. int mode=0;
  2457. while(*opt!='\0')
  2458. {
  2459. if (*opt=='i') mode |= PROT_I;
  2460. else if (*opt=='o') mode |= PROT_O;
  2461. opt++;
  2462. }
  2463. monitor((char *)(u->Data()),mode);
  2464. #else
  2465. si_link l=(si_link)u->Data();
  2466. if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
  2467. if(strcmp(l->m->type,"ASCII")!=0)
  2468. {
  2469. Werror("ASCII link required, not `%s`",l->m->type);
  2470. slClose(l);
  2471. return TRUE;
  2472. }
  2473. SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
  2474. if ( l->name[0]!='\0') // "" is the stop condition
  2475. {
  2476. const char *opt;
  2477. int mode=0;
  2478. if (v==NULL) opt=(const char*)"i";
  2479. else opt=(const char *)v->Data();
  2480. while(*opt!='\0')
  2481. {
  2482. if (*opt=='i') mode |= PROT_I;
  2483. else if (*opt=='o') mode |= PROT_O;
  2484. opt++;
  2485. }
  2486. monitor((FILE *)l->data,mode);
  2487. }
  2488. else
  2489. monitor(NULL,0);
  2490. return FALSE;
  2491. #endif
  2492. }
  2493. static BOOLEAN jjMONOM(leftv res, leftv v)
  2494. {
  2495. intvec *iv=(intvec *)v->Data();
  2496. poly p=pOne();
  2497. int i,e;
  2498. BOOLEAN err=FALSE;
  2499. for(i=si_min(pVariables,iv->length()); i>0; i--)
  2500. {
  2501. e=(*iv)[i-1];
  2502. if (e>=0) pSetExp(p,i,e);
  2503. else err=TRUE;
  2504. }
  2505. if (iv->length()==(pVariables+1))
  2506. {
  2507. res->rtyp=VECTOR_CMD;
  2508. e=(*iv)[pVariables];
  2509. if (e>=0) pSetComp(p,e);
  2510. else err=TRUE;
  2511. }
  2512. pSetm(p);
  2513. res->data=(char*)p;
  2514. if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
  2515. return err;
  2516. }
  2517. static BOOLEAN jjNEWSTRUCT2(leftv res, leftv u, leftv v)
  2518. {
  2519. // u: the name of the new type
  2520. // v: the elements
  2521. newstruct_desc d=newstructFromString((const char *)v->Data());
  2522. if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
  2523. return d==NULL;
  2524. }
  2525. static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
  2526. {
  2527. idhdl h=(idhdl)u->data;
  2528. int i=(int)(long)v->Data();
  2529. int p=0;
  2530. if ((0<i)
  2531. && (IDRING(h)->parameter!=NULL)
  2532. && (i<=(p=rPar(IDRING(h)))))
  2533. res->data=omStrDup(IDRING(h)->parameter[i-1]);
  2534. else
  2535. {
  2536. Werror("par number %d out of range 1..%d",i,p);
  2537. return TRUE;
  2538. }
  2539. return FALSE;
  2540. }
  2541. #ifdef HAVE_PLURAL
  2542. static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
  2543. {
  2544. if( currRing->qideal != NULL )
  2545. {
  2546. WerrorS("basering must NOT be a qring!");
  2547. return TRUE;
  2548. }
  2549. if (iiOp==NCALGEBRA_CMD)
  2550. {
  2551. return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing);
  2552. }
  2553. else
  2554. {
  2555. ring r=rCopy(currRing);
  2556. BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r);
  2557. res->data=r;
  2558. if (r->qideal!=NULL) res->rtyp=QRING_CMD;
  2559. return result;
  2560. }
  2561. }
  2562. static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
  2563. {
  2564. if( currRing->qideal != NULL )
  2565. {
  2566. WerrorS("basering must NOT be a qring!");
  2567. return TRUE;
  2568. }
  2569. if (iiOp==NCALGEBRA_CMD)
  2570. {
  2571. return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing);
  2572. }
  2573. else
  2574. {
  2575. ring r=rCopy(currRing);
  2576. BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r);
  2577. res->data=r;
  2578. if (r->qideal!=NULL) res->rtyp=QRING_CMD;
  2579. return result;
  2580. }
  2581. }
  2582. static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
  2583. {
  2584. if( currRing->qideal != NULL )
  2585. {
  2586. WerrorS("basering must NOT be a qring!");
  2587. return TRUE;
  2588. }
  2589. if (iiOp==NCALGEBRA_CMD)
  2590. {
  2591. return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing);
  2592. }
  2593. else
  2594. {
  2595. ring r=rCopy(currRing);
  2596. BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r);
  2597. res->data=r;
  2598. if (r->qideal!=NULL) res->rtyp=QRING_CMD;
  2599. return result;
  2600. }
  2601. }
  2602. static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
  2603. {
  2604. if( currRing->qideal != NULL )
  2605. {
  2606. WerrorS("basering must NOT be a qring!");
  2607. return TRUE;
  2608. }
  2609. if (iiOp==NCALGEBRA_CMD)
  2610. {
  2611. return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing);
  2612. }
  2613. else
  2614. {
  2615. ring r=rCopy(currRing);
  2616. BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r);
  2617. res->data=r;
  2618. if (r->qideal!=NULL) res->rtyp=QRING_CMD;
  2619. return result;
  2620. }
  2621. }
  2622. static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
  2623. {
  2624. res->data=NULL;
  2625. if (rIsPluralRing(currRing))
  2626. {
  2627. const poly q = (poly)b->Data();
  2628. if( q != NULL )
  2629. {
  2630. if( (poly)a->Data() != NULL )
  2631. {
  2632. poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
  2633. res->data = nc_p_Bracket_qq(p,q); // p will be destroyed!
  2634. }
  2635. }
  2636. }
  2637. return FALSE;
  2638. }
  2639. static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
  2640. {
  2641. /* number, poly, vector, ideal, module, matrix */
  2642. ring r = (ring)a->Data();
  2643. if (r == currRing)
  2644. {
  2645. res->data = b->Data();
  2646. res->rtyp = b->rtyp;
  2647. return FALSE;
  2648. }
  2649. if (!rIsLikeOpposite(currRing, r))
  2650. {
  2651. Werror("%s is not an opposite ring to current ring",a->Fullname());
  2652. return TRUE;
  2653. }
  2654. idhdl w;
  2655. if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
  2656. {
  2657. int argtype = IDTYP(w);
  2658. switch (argtype)
  2659. {
  2660. case NUMBER_CMD:
  2661. {
  2662. /* since basefields are equal, we can apply nCopy */
  2663. res->data = nCopy((number)IDDATA(w));
  2664. res->rtyp = argtype;
  2665. break;
  2666. }
  2667. case POLY_CMD:
  2668. case VECTOR_CMD:
  2669. {
  2670. poly q = (poly)IDDATA(w);
  2671. res->data = pOppose(r,q);
  2672. res->rtyp = argtype;
  2673. break;
  2674. }
  2675. case IDEAL_CMD:
  2676. case MODUL_CMD:
  2677. {
  2678. ideal Q = (ideal)IDDATA(w);
  2679. res->data = idOppose(r,Q);
  2680. res->rtyp = argtype;
  2681. break;
  2682. }
  2683. case MATRIX_CMD:
  2684. {
  2685. ring save = currRing;
  2686. rChangeCurrRing(r);
  2687. matrix m = (matrix)IDDATA(w);
  2688. ideal Q = idMatrix2Module(mpCopy(m));
  2689. rChangeCurrRing(save);
  2690. ideal S = idOppose(r,Q);
  2691. id_Delete(&Q, r);
  2692. res->data = idModule2Matrix(S);
  2693. res->rtyp = argtype;
  2694. break;
  2695. }
  2696. default:
  2697. {
  2698. WerrorS("unsupported type in oppose");
  2699. return TRUE;
  2700. }
  2701. }
  2702. }
  2703. else
  2704. {
  2705. Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
  2706. return TRUE;
  2707. }
  2708. return FALSE;
  2709. }
  2710. #endif /* HAVE_PLURAL */
  2711. static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
  2712. {
  2713. res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
  2714. hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
  2715. idDelMultiples((ideal)(res->data));
  2716. return FALSE;
  2717. }
  2718. static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
  2719. {
  2720. int i=(int)(long)u->Data();
  2721. int j=(int)(long)v->Data();
  2722. res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
  2723. return FALSE;
  2724. }
  2725. static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
  2726. {
  2727. matrix m =(matrix)u->Data();
  2728. int isRowEchelon = (int)(long)v->Data();
  2729. if (isRowEchelon != 1) isRowEchelon = 0;
  2730. int rank = luRank(m, isRowEchelon);
  2731. res->data =(char *)(long)rank;
  2732. return FALSE;
  2733. }
  2734. static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
  2735. {
  2736. si_link l=(si_link)u->Data();
  2737. leftv r=slRead(l,v);
  2738. if (r==NULL)
  2739. {
  2740. const char *s;
  2741. if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
  2742. else s=sNoName;
  2743. Werror("cannot read from `%s`",s);
  2744. return TRUE;
  2745. }
  2746. memcpy(res,r,sizeof(sleftv));
  2747. omFreeBin((ADDRESS)r, sleftv_bin);
  2748. return FALSE;
  2749. }
  2750. static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
  2751. {
  2752. assumeStdFlag(v);
  2753. res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
  2754. return FALSE;
  2755. }
  2756. static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
  2757. {
  2758. assumeStdFlag(v);
  2759. ideal ui=(ideal)u->Data();
  2760. idTest(ui);
  2761. ideal vi=(ideal)v->Data();
  2762. idTest(vi);
  2763. res->data = (char *)kNF(vi,currQuotient,ui);
  2764. return FALSE;
  2765. }
  2766. #if 0
  2767. static BOOLEAN jjRES(leftv res, leftv u, leftv v)
  2768. {
  2769. int maxl=(int)(long)v->Data();
  2770. if (maxl<0)
  2771. {
  2772. WerrorS("length for res must not be negative");
  2773. return TRUE;
  2774. }
  2775. int l=0;
  2776. //resolvente r;
  2777. syStrategy r;
  2778. intvec *weights=NULL;
  2779. int wmaxl=maxl;
  2780. ideal u_id=(ideal)u->Data();
  2781. maxl--;
  2782. if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
  2783. {
  2784. maxl = pVariables-1+2*(iiOp==MRES_CMD);
  2785. if (currQuotient!=NULL)
  2786. {
  2787. Warn(
  2788. "full resolution in a qring may be infinite, setting max length to %d",
  2789. maxl+1);
  2790. }
  2791. }
  2792. weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
  2793. if (weights!=NULL)
  2794. {
  2795. if (!idTestHomModule(u_id,currQuotient,weights))
  2796. {
  2797. WarnS("wrong weights given:");weights->show();PrintLn();
  2798. weights=NULL;
  2799. }
  2800. }
  2801. intvec *ww=NULL;
  2802. int add_row_shift=0;
  2803. if (weights!=NULL)
  2804. {
  2805. ww=ivCopy(weights);
  2806. add_row_shift = ww->min_in();
  2807. (*ww) -= add_row_shift;
  2808. }
  2809. else
  2810. idHomModule(u_id,currQuotient,&ww);
  2811. weights=ww;
  2812. if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
  2813. {
  2814. r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
  2815. }
  2816. else if (iiOp==SRES_CMD)
  2817. // r=sySchreyerResolvente(u_id,maxl+1,&l);
  2818. r=sySchreyer(u_id,maxl+1);
  2819. else if (iiOp == LRES_CMD)
  2820. {
  2821. int dummy;
  2822. if((currQuotient!=NULL)||
  2823. (!idHomIdeal (u_id,NULL)))
  2824. {
  2825. WerrorS
  2826. ("`lres` not implemented for inhomogeneous input or qring");
  2827. return TRUE;
  2828. }
  2829. r=syLaScala3(u_id,&dummy);
  2830. }
  2831. else if (iiOp == KRES_CMD)
  2832. {
  2833. int dummy;
  2834. if((currQuotient!=NULL)||
  2835. (!idHomIdeal (u_id,NULL)))
  2836. {
  2837. WerrorS
  2838. ("`kres` not implemented for inhomogeneous input or qring");
  2839. return TRUE;
  2840. }
  2841. r=syKosz(u_id,&dummy);
  2842. }
  2843. else
  2844. {
  2845. int dummy;
  2846. if((currQuotient!=NULL)||
  2847. (!idHomIdeal (u_id,NULL)))
  2848. {
  2849. WerrorS
  2850. ("`hres` not implemented for inhomogeneous input or qring");
  2851. return TRUE;
  2852. }
  2853. r=syHilb(u_id,&dummy);
  2854. }
  2855. if (r==NULL) return TRUE;
  2856. //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
  2857. r->list_length=wmaxl;
  2858. res->data=(void *)r;
  2859. if ((r->weights!=NULL) && (r->weights[0]!=NULL))
  2860. {
  2861. intvec *w=ivCopy(r->weights[0]);
  2862. if (weights!=NULL) (*w) += add_row_shift;
  2863. atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
  2864. w=NULL;
  2865. }
  2866. else
  2867. {
  2868. //#if 0
  2869. // need to set weights for ALL components (sres)
  2870. if (weights!=NULL)
  2871. {
  2872. atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
  2873. r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
  2874. (r->weights)[0] = ivCopy(weights);
  2875. }
  2876. //#endif
  2877. }
  2878. if (ww!=NULL) { delete ww; ww=NULL; }
  2879. return FALSE;
  2880. }
  2881. #else
  2882. static BOOLEAN jjRES(leftv res, leftv u, leftv v)
  2883. {
  2884. int maxl=(int)(long)v->Data();
  2885. if (maxl<0)
  2886. {
  2887. WerrorS("length for res must not be negative");
  2888. return TRUE;
  2889. }
  2890. int l=0;
  2891. //resolvente r;
  2892. syStrategy r;
  2893. intvec *weights=NULL;
  2894. int wmaxl=maxl;
  2895. ideal u_id=(ideal)u->Data();
  2896. maxl--;
  2897. if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
  2898. {
  2899. maxl = pVariables-1+2*(iiOp==MRES_CMD);
  2900. if (currQuotient!=NULL)
  2901. {
  2902. Warn(
  2903. "full resolution in a qring may be infinite, setting max length to %d",
  2904. maxl+1);
  2905. }
  2906. }
  2907. weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
  2908. if (weights!=NULL)
  2909. {
  2910. if (!idTestHomModule(u_id,currQuotient,weights))
  2911. {
  2912. WarnS("wrong weights given:");weights->show();PrintLn();
  2913. weights=NULL;
  2914. }
  2915. }
  2916. intvec *ww=NULL;
  2917. int add_row_shift=0;
  2918. if (weights!=NULL)
  2919. {
  2920. ww=ivCopy(weights);
  2921. add_row_shift = ww->min_in();
  2922. (*ww) -= add_row_shift;
  2923. }
  2924. if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
  2925. {
  2926. r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
  2927. }
  2928. else if (iiOp==SRES_CMD)
  2929. // r=sySchreyerResolvente(u_id,maxl+1,&l);
  2930. r=sySchreyer(u_id,maxl+1);
  2931. else if (iiOp == LRES_CMD)
  2932. {
  2933. int dummy;
  2934. if((currQuotient!=NULL)||
  2935. (!idHomIdeal (u_id,NULL)))
  2936. {
  2937. WerrorS
  2938. ("`lres` not implemented for inhomogeneous input or qring");
  2939. return TRUE;
  2940. }
  2941. if(currRing->N == 1)
  2942. WarnS("the current implementation of `lres` may not work in the case of a single variable");
  2943. r=syLaScala3(u_id,&dummy);
  2944. }
  2945. else if (iiOp == KRES_CMD)
  2946. {
  2947. int dummy;
  2948. if((currQuotient!=NULL)||
  2949. (!idHomIdeal (u_id,NULL)))
  2950. {
  2951. WerrorS
  2952. ("`kres` not implemented for inhomogeneous input or qring");
  2953. return TRUE;
  2954. }
  2955. r=syKosz(u_id,&dummy);
  2956. }
  2957. else
  2958. {
  2959. int dummy;
  2960. if((currQuotient!=NULL)||
  2961. (!idHomIdeal (u_id,NULL)))
  2962. {
  2963. WerrorS
  2964. ("`hres` not implemented for inhomogeneous input or qring");
  2965. return TRUE;
  2966. }
  2967. ideal u_id_copy=idCopy(u_id);
  2968. idSkipZeroes(u_id_copy);
  2969. r=syHilb(u_id_copy,&dummy);
  2970. idDelete(&u_id_copy);
  2971. }
  2972. if (r==NULL) return TRUE;
  2973. //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
  2974. r->list_length=wmaxl;
  2975. res->data=(void *)r;
  2976. if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
  2977. if ((r->weights!=NULL) && (r->weights[0]!=NULL))
  2978. {
  2979. ww=ivCopy(r->weights[0]);
  2980. if (weights!=NULL) (*ww) += add_row_shift;
  2981. atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
  2982. }
  2983. else
  2984. {
  2985. if (weights!=NULL)
  2986. {
  2987. atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
  2988. }
  2989. }
  2990. // test the La Scala case' output
  2991. assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
  2992. assume( (r->syRing != NULL) == (r->resPairs != NULL) );
  2993. if(iiOp != HRES_CMD)
  2994. assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
  2995. else
  2996. assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
  2997. return FALSE;
  2998. }
  2999. #endif
  3000. static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
  3001. {
  3002. number n1; number n2; number temp; int i;
  3003. if ((u->Typ() == BIGINT_CMD) ||
  3004. ((u->Typ() == NUMBER_CMD) && rField_is_Q()))
  3005. {
  3006. temp = (number)u->Data();
  3007. n1 = nlCopy(temp);
  3008. }
  3009. else if (u->Typ() == INT_CMD)
  3010. {
  3011. i = (int)(long)u->Data();
  3012. n1 = nlInit(i, NULL);
  3013. }
  3014. else
  3015. {
  3016. WerrorS("wrong type: expected int, bigint, or number as 1st argument");
  3017. return TRUE;
  3018. }
  3019. if ((v->Typ() == BIGINT_CMD) ||
  3020. ((v->Typ() == NUMBER_CMD) && rField_is_Q()))
  3021. {
  3022. temp = (number)v->Data();
  3023. n2 = nlCopy(temp);
  3024. }
  3025. else if (v->Typ() == INT_CMD)
  3026. {
  3027. i = (int)(long)v->Data();
  3028. n2 = nlInit(i, NULL);
  3029. }
  3030. else
  3031. {
  3032. WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
  3033. return TRUE;
  3034. }
  3035. lists l = primeFactorisation(n1, n2);
  3036. nlDelete(&n1, NULL); nlDelete(&n2, NULL);
  3037. res->data = (char*)l;
  3038. return FALSE;
  3039. }
  3040. static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
  3041. {
  3042. ring r;
  3043. int i=rSum((ring)u->Data(),(ring)v->Data(),r);
  3044. res->data = (char *)r;
  3045. return (i==-1);
  3046. }
  3047. #define SIMPL_LMDIV 32
  3048. #define SIMPL_LMEQ 16
  3049. #define SIMPL_MULT 8
  3050. #define SIMPL_EQU 4
  3051. #define SIMPL_NULL 2
  3052. #define SIMPL_NORM 1
  3053. static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
  3054. {
  3055. int sw = (int)(long)v->Data();
  3056. // CopyD for IDEAL_CMD and MODUL_CMD are identical:
  3057. ideal id = (ideal)u->CopyD(IDEAL_CMD);
  3058. if (sw & SIMPL_LMDIV)
  3059. {
  3060. idDelDiv(id);
  3061. }
  3062. if (sw & SIMPL_LMEQ)
  3063. {
  3064. idDelLmEquals(id);
  3065. }
  3066. if (sw & SIMPL_MULT)
  3067. {
  3068. idDelMultiples(id);
  3069. }
  3070. else if(sw & SIMPL_EQU)
  3071. {
  3072. idDelEquals(id);
  3073. }
  3074. if (sw & SIMPL_NULL)
  3075. {
  3076. idSkipZeroes(id);
  3077. }
  3078. if (sw & SIMPL_NORM)
  3079. {
  3080. idNorm(id);
  3081. }
  3082. res->data = (char * )id;
  3083. return FALSE;
  3084. }
  3085. static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
  3086. {
  3087. res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
  3088. return FALSE;
  3089. }
  3090. static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
  3091. {
  3092. res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
  3093. //return (res->data== (void*)(long)-2);
  3094. return FALSE;
  3095. }
  3096. static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
  3097. {
  3098. int sw = (int)(long)v->Data();
  3099. // CopyD for POLY_CMD and VECTOR_CMD are identical:
  3100. poly p = (poly)u->CopyD(POLY_CMD);
  3101. if (sw & SIMPL_NORM)
  3102. {
  3103. pNorm(p);
  3104. }
  3105. res->data = (char * )p;
  3106. return FALSE;
  3107. }
  3108. static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
  3109. {
  3110. ideal result;
  3111. intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  3112. tHomog hom=testHomog;
  3113. ideal u_id=(ideal)(u->Data());
  3114. if (w!=NULL)
  3115. {
  3116. if (!idTestHomModule(u_id,currQuotient,w))
  3117. {
  3118. WarnS("wrong weights:");w->show();PrintLn();
  3119. w=NULL;
  3120. }
  3121. else
  3122. {
  3123. w=ivCopy(w);
  3124. hom=isHomog;
  3125. }
  3126. }
  3127. result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
  3128. idSkipZeroes(result);
  3129. res->data = (char *)result;
  3130. setFlag(res,FLAG_STD);
  3131. if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
  3132. return FALSE;
  3133. }
  3134. static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
  3135. static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
  3136. /* destroys i0, p0 */
  3137. /* result (with attributes) in res */
  3138. /* i0: SB*/
  3139. /* t0: type of p0*/
  3140. /* p0 new elements*/
  3141. /* a attributes of i0*/
  3142. {
  3143. int tp;
  3144. if (t0==IDEAL_CMD) tp=POLY_CMD;
  3145. else tp=VECTOR_CMD;
  3146. for (int i=IDELEMS(p0)-1; i>=0; i--)
  3147. {
  3148. poly p=p0->m[i];
  3149. p0->m[i]=NULL;
  3150. if (p!=NULL)
  3151. {
  3152. sleftv u0,v0;
  3153. memset(&u0,0,sizeof(sleftv));
  3154. memset(&v0,0,sizeof(sleftv));
  3155. v0.rtyp=tp;
  3156. v0.data=(void*)p;
  3157. u0.rtyp=t0;
  3158. u0.data=i0;
  3159. u0.attribute=a;
  3160. setFlag(&u0,FLAG_STD);
  3161. jjSTD_1(res,&u0,&v0);
  3162. i0=(ideal)res->data;
  3163. res->data=NULL;
  3164. a=res->attribute;
  3165. res->attribute=NULL;
  3166. u0.CleanUp();
  3167. v0.CleanUp();
  3168. res->CleanUp();
  3169. }
  3170. }
  3171. idDelete(&p0);
  3172. res->attribute=a;
  3173. res->data=(void *)i0;
  3174. res->rtyp=t0;
  3175. }
  3176. static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
  3177. {
  3178. ideal result;
  3179. assumeStdFlag(u);
  3180. ideal i1=(ideal)(u->Data());
  3181. ideal i0;
  3182. int r=v->Typ();
  3183. if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
  3184. {
  3185. i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
  3186. i0->m[0]=(poly)v->Data();
  3187. int ii0=idElem(i0); /* size of i0 */
  3188. i1=idSimpleAdd(i1,i0); //
  3189. memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
  3190. idDelete(&i0);
  3191. intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  3192. tHomog hom=testHomog;
  3193. if (w!=NULL)
  3194. {
  3195. if (!idTestHomModule(i1,currQuotient,w))
  3196. {
  3197. // no warnung: this is legal, if i in std(i,p)
  3198. // is homogeneous, but p not
  3199. w=NULL;
  3200. }
  3201. else
  3202. {
  3203. w=ivCopy(w);
  3204. hom=isHomog;
  3205. }
  3206. }
  3207. BITSET save_test=test;
  3208. test|=Sy_bit(OPT_SB_1);
  3209. /* ii0 appears to be the position of the first element of il that
  3210. does not belong to the old SB ideal */
  3211. result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
  3212. test=save_test;
  3213. idDelete(&i1);
  3214. idSkipZeroes(result);
  3215. if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
  3216. res->data = (char *)result;
  3217. }
  3218. else /*IDEAL/MODULE*/
  3219. {
  3220. attr *aa=u->Attribute();
  3221. attr a=NULL;
  3222. if (aa!=NULL) a=(*aa)->Copy();
  3223. jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
  3224. }
  3225. if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
  3226. return FALSE;
  3227. }
  3228. static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
  3229. {
  3230. idhdl h=(idhdl)u->data;
  3231. int i=(int)(long)v->Data();
  3232. if ((0<i) && (i<=IDRING(h)->N))
  3233. res->data=omStrDup(IDRING(h)->names[i-1]);
  3234. else
  3235. {
  3236. Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
  3237. return TRUE;
  3238. }
  3239. return FALSE;
  3240. }
  3241. static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
  3242. {
  3243. // input: u: a list with links of type
  3244. // ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
  3245. // v: timeout for select in milliseconds
  3246. // or 0 for polling
  3247. // returns: ERROR (via Werror): timeout negative
  3248. // -1: the read state of all links is eof
  3249. // 0: timeout (or polling): none ready
  3250. // i>0: (at least) L[i] is ready
  3251. lists Lforks = (lists)u->Data();
  3252. int t = (int)(long)v->Data();
  3253. if(t < 0)
  3254. {
  3255. WerrorS("negative timeout"); return TRUE;
  3256. }
  3257. int i = slStatusSsiL(Lforks, t*1000);
  3258. if(i == -2) /* error */
  3259. {
  3260. return TRUE;
  3261. }
  3262. res->data = (void*)(long)i;
  3263. return FALSE;
  3264. }
  3265. static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
  3266. {
  3267. // input: u: a list with links of type
  3268. // ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
  3269. // v: timeout for select in milliseconds
  3270. // or 0 for polling
  3271. // returns: ERROR (via Werror): timeout negative
  3272. // -1: the read state of all links is eof
  3273. // 0: timeout (or polling): none ready
  3274. // 1: all links are ready
  3275. // (caution: at least one is ready, but some maybe dead)
  3276. lists Lforks = (lists)u->CopyD();
  3277. int timeout = 1000*(int)(long)v->Data();
  3278. if(timeout < 0)
  3279. {
  3280. WerrorS("negative timeout"); return TRUE;
  3281. }
  3282. int t = getRTimer()/TIMER_RESOLUTION; // in seconds
  3283. int i;
  3284. int ret = -1;
  3285. for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
  3286. {
  3287. i = slStatusSsiL(Lforks, timeout);
  3288. if(i > 0) /* Lforks[i] is ready */
  3289. {
  3290. ret = 1;
  3291. Lforks->m[i-1].CleanUp();
  3292. Lforks->m[i-1].rtyp=DEF_CMD;
  3293. Lforks->m[i-1].data=NULL;
  3294. timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
  3295. }
  3296. else /* terminate the for loop */
  3297. {
  3298. if(i == -2) /* error */
  3299. {
  3300. return TRUE;
  3301. }
  3302. if(i == 0) /* timeout */
  3303. {
  3304. ret = 0;
  3305. }
  3306. break;
  3307. }
  3308. }
  3309. Lforks->Clean();
  3310. res->data = (void*)(long)ret;
  3311. return FALSE;
  3312. }
  3313. static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
  3314. {
  3315. res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
  3316. return FALSE;
  3317. }
  3318. #define jjWRONG2 (proc2)jjWRONG
  3319. #define jjWRONG3 (proc3)jjWRONG
  3320. static BOOLEAN jjWRONG(leftv res, leftv u)
  3321. {
  3322. return TRUE;
  3323. }
  3324. /*=================== operations with 1 arg.: static proc =================*/
  3325. /* must be ordered: first operations for chars (infix ops),
  3326. * then alphabetically */
  3327. static BOOLEAN jjDUMMY(leftv res, leftv u)
  3328. {
  3329. res->data = (char *)u->CopyD();
  3330. return FALSE;
  3331. }
  3332. static BOOLEAN jjNULL(leftv res, leftv u)
  3333. {
  3334. return FALSE;
  3335. }
  3336. //static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
  3337. //{
  3338. // res->data = (char *)((int)(long)u->Data()+1);
  3339. // return FALSE;
  3340. //}
  3341. //static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
  3342. //{
  3343. // res->data = (char *)((int)(long)u->Data()-1);
  3344. // return FALSE;
  3345. //}
  3346. static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
  3347. {
  3348. if (IDTYP((idhdl)u->data)==INT_CMD)
  3349. {
  3350. int i=IDINT((idhdl)u->data);
  3351. if (iiOp==PLUSPLUS) i++;
  3352. else i--;
  3353. IDDATA((idhdl)u->data)=(char *)(long)i;
  3354. return FALSE;
  3355. }
  3356. return TRUE;
  3357. }
  3358. static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
  3359. {
  3360. number n=(number)u->CopyD(BIGINT_CMD);
  3361. n=nlNeg(n);
  3362. res->data = (char *)n;
  3363. return FALSE;
  3364. }
  3365. static BOOLEAN jjUMINUS_I(leftv res, leftv u)
  3366. {
  3367. res->data = (char *)(-(long)u->Data());
  3368. return FALSE;
  3369. }
  3370. static BOOLEAN jjUMINUS_N(leftv res, leftv u)
  3371. {
  3372. number n=(number)u->CopyD(NUMBER_CMD);
  3373. n=nNeg(n);
  3374. res->data = (char *)n;
  3375. return FALSE;
  3376. }
  3377. static BOOLEAN jjUMINUS_P(leftv res, leftv u)
  3378. {
  3379. res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
  3380. return FALSE;
  3381. }
  3382. static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
  3383. {
  3384. poly m1=pISet(-1);
  3385. res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
  3386. return FALSE;
  3387. }
  3388. static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
  3389. {
  3390. intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
  3391. (*iv)*=(-1);
  3392. res->data = (char *)iv;
  3393. return FALSE;
  3394. }
  3395. static BOOLEAN jjPROC1(leftv res, leftv u)
  3396. {
  3397. return jjPROC(res,u,NULL);
  3398. }
  3399. static BOOLEAN jjBAREISS(leftv res, leftv v)
  3400. {
  3401. //matrix m=(matrix)v->Data();
  3402. //lists l=mpBareiss(m,FALSE);
  3403. intvec *iv;
  3404. ideal m;
  3405. smCallBareiss((ideal)v->Data(),0,0,m,&iv);
  3406. lists l=(lists)omAllocBin(slists_bin);
  3407. l->Init(2);
  3408. l->m[0].rtyp=MODUL_CMD;
  3409. l->m[1].rtyp=INTVEC_CMD;
  3410. l->m[0].data=(void *)m;
  3411. l->m[1].data=(void *)iv;
  3412. res->data = (char *)l;
  3413. return FALSE;
  3414. }
  3415. //static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
  3416. //{
  3417. // intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
  3418. // ivTriangMat(m);
  3419. // res->data = (char *)m;
  3420. // return FALSE;
  3421. //}
  3422. static BOOLEAN jjBI2N(leftv res, leftv u)
  3423. {
  3424. if (rField_is_Q())
  3425. {
  3426. res->data=u->CopyD();
  3427. return FALSE;
  3428. }
  3429. else
  3430. {
  3431. BOOLEAN bo=FALSE;
  3432. number n=(number)u->CopyD();
  3433. if (rField_is_Zp())
  3434. {
  3435. res->data=(void *)npMap0(n);
  3436. }
  3437. else if (rField_is_Q_a())
  3438. {
  3439. res->data=(void *)naMap00(n);
  3440. }
  3441. else if (rField_is_Zp_a())
  3442. {
  3443. res->data=(void *)naMap0P(n);
  3444. }
  3445. #ifdef HAVE_RINGS
  3446. else if (rField_is_Ring_Z())
  3447. {
  3448. res->data=(void *)nrzMapQ(n);
  3449. }
  3450. else if (rField_is_Ring_ModN())
  3451. {
  3452. res->data=(void *)nrnMapQ(n);
  3453. }
  3454. else if (rField_is_Ring_PtoM())
  3455. {
  3456. res->data=(void *)nrnMapQ(n);
  3457. }
  3458. else if (rField_is_Ring_2toM())
  3459. {
  3460. res->data=(void *)nr2mMapQ(n);
  3461. }
  3462. #endif
  3463. else
  3464. {
  3465. WerrorS("cannot convert bigint to this field");
  3466. bo=TRUE;
  3467. }
  3468. nlDelete(&n,NULL);
  3469. return bo;
  3470. }
  3471. }
  3472. static BOOLEAN jjBI2P(leftv res, leftv u)
  3473. {
  3474. sleftv tmp;
  3475. BOOLEAN bo=jjBI2N(&tmp,u);
  3476. if (!bo)
  3477. {
  3478. number n=(number) tmp.data;
  3479. if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
  3480. else
  3481. {
  3482. res->data=(void *)pNSet(n);
  3483. }
  3484. }
  3485. return bo;
  3486. }
  3487. static BOOLEAN jjCALL1MANY(leftv res, leftv u)
  3488. {
  3489. return iiExprArithM(res,u,iiOp);
  3490. }
  3491. static BOOLEAN jjCHAR(leftv res, leftv v)
  3492. {
  3493. res->data = (char *)(long)rChar((ring)v->Data());
  3494. return FALSE;
  3495. }
  3496. static BOOLEAN jjCOLS(leftv res, leftv v)
  3497. {
  3498. res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
  3499. return FALSE;
  3500. }
  3501. static BOOLEAN jjCOLS_IV(leftv res, leftv v)
  3502. {
  3503. res->data = (char *)(long)((intvec*)(v->Data()))->cols();
  3504. return FALSE;
  3505. }
  3506. static BOOLEAN jjCONTENT(leftv res, leftv v)
  3507. {
  3508. // CopyD for POLY_CMD and VECTOR_CMD are identical:
  3509. poly p=(poly)v->CopyD(POLY_CMD);
  3510. if (p!=NULL) p_Cleardenom(p, currRing);
  3511. res->data = (char *)p;
  3512. return FALSE;
  3513. }
  3514. static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
  3515. {
  3516. res->data = (char *)(long)nlSize((number)v->Data());
  3517. return FALSE;
  3518. }
  3519. static BOOLEAN jjCOUNT_N(leftv res, leftv v)
  3520. {
  3521. res->data = (char *)(long)nSize((number)v->Data());
  3522. return FALSE;
  3523. }
  3524. static BOOLEAN jjCOUNT_L(leftv res, leftv v)
  3525. {
  3526. lists l=(lists)v->Data();
  3527. res->data = (char *)(long)(l->nr+1);
  3528. return FALSE;
  3529. }
  3530. static BOOLEAN jjCOUNT_M(leftv res, leftv v)
  3531. {
  3532. matrix m=(matrix)v->Data();
  3533. res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
  3534. return FALSE;
  3535. }
  3536. static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
  3537. {
  3538. res->data = (char *)(long)((intvec*)(v->Data()))->length();
  3539. return FALSE;
  3540. }
  3541. static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
  3542. {
  3543. ring r=(ring)v->Data();
  3544. int elems=-1;
  3545. if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
  3546. else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
  3547. {
  3548. #ifdef HAVE_FACTORY
  3549. extern int ipower ( int b, int n ); /* factory/cf_util */
  3550. elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
  3551. #else
  3552. elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
  3553. #endif
  3554. }
  3555. res->data = (char *)(long)elems;
  3556. return FALSE;
  3557. }
  3558. static BOOLEAN jjDEG(leftv res, leftv v)
  3559. {
  3560. int dummy;
  3561. poly p=(poly)v->Data();
  3562. if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
  3563. else res->data=(char *)-1;
  3564. return FALSE;
  3565. }
  3566. static BOOLEAN jjDEG_M(leftv res, leftv u)
  3567. {
  3568. ideal I=(ideal)u->Data();
  3569. int d=-1;
  3570. int dummy;
  3571. int i;
  3572. for(i=IDELEMS(I)-1;i>=0;i--)
  3573. if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
  3574. res->data = (char *)(long)d;
  3575. return FALSE;
  3576. }
  3577. static BOOLEAN jjDEGREE(leftv res, leftv v)
  3578. {
  3579. #ifdef HAVE_RINGS
  3580. if (rField_is_Ring_Z(currRing))
  3581. {
  3582. ring origR = currRing;
  3583. ring tempR = rCopy(origR);
  3584. tempR->ringtype = 0; tempR->ch = 0;
  3585. rComplete(tempR);
  3586. ideal vid = (ideal)v->Data();
  3587. rChangeCurrRing(tempR);
  3588. ideal vv = idrCopyR(vid, origR, currRing);
  3589. sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
  3590. vvAsLeftv.rtyp = IDEAL_CMD;
  3591. vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
  3592. if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
  3593. assumeStdFlag(&vvAsLeftv);
  3594. Print("// NOTE: computation of degree is being performed for\n");
  3595. Print("// generic fibre, that is, over Q\n");
  3596. intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
  3597. scDegree(vv,module_w,currQuotient);
  3598. idDelete(&vv);
  3599. rChangeCurrRing(origR);
  3600. rDelete(tempR);
  3601. return FALSE;
  3602. }
  3603. #endif
  3604. assumeStdFlag(v);
  3605. intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  3606. scDegree((ideal)v->Data(),module_w,currQuotient);
  3607. return FALSE;
  3608. }
  3609. static BOOLEAN jjDEFINED(leftv res, leftv v)
  3610. {
  3611. if ((v->rtyp==IDHDL)
  3612. && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
  3613. {
  3614. res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
  3615. }
  3616. else if (v->rtyp!=0) res->data=(void *)(-1);
  3617. return FALSE;
  3618. }
  3619. #ifdef HAVE_FACTORY
  3620. static BOOLEAN jjDET(leftv res, leftv v)
  3621. {
  3622. matrix m=(matrix)v->Data();
  3623. poly p;
  3624. if (smCheckDet((ideal)m,m->cols(),TRUE))
  3625. {
  3626. ideal I=idMatrix2Module(mpCopy(m));
  3627. p=smCallDet(I);
  3628. idDelete(&I);
  3629. }
  3630. else
  3631. p=singclap_det(m);
  3632. res ->data = (char *)p;
  3633. return FALSE;
  3634. }
  3635. static BOOLEAN jjDET_I(leftv res, leftv v)
  3636. {
  3637. intvec * m=(intvec*)v->Data();
  3638. int i,j;
  3639. i=m->rows();j=m->cols();
  3640. if(i==j)
  3641. res->data = (char *)(long)singclap_det_i(m);
  3642. else
  3643. {
  3644. Werror("det of %d x %d intmat",i,j);
  3645. return TRUE;
  3646. }
  3647. return FALSE;
  3648. }
  3649. static BOOLEAN jjDET_S(leftv res, leftv v)
  3650. {
  3651. ideal I=(ideal)v->Data();
  3652. poly p;
  3653. if (IDELEMS(I)<1) return TRUE;
  3654. if (smCheckDet(I,IDELEMS(I),FALSE))
  3655. {
  3656. matrix m=idModule2Matrix(idCopy(I));
  3657. p=singclap_det(m);
  3658. idDelete((ideal *)&m);
  3659. }
  3660. else
  3661. p=smCallDet(I);
  3662. res->data = (char *)p;
  3663. return FALSE;
  3664. }
  3665. #endif
  3666. static BOOLEAN jjDIM(leftv res, leftv v)
  3667. {
  3668. assumeStdFlag(v);
  3669. #ifdef HAVE_RINGS
  3670. if (rField_is_Ring(currRing))
  3671. {
  3672. ring origR = currRing;
  3673. ring tempR = rCopy(origR);
  3674. tempR->ringtype = 0; tempR->ch = 0;
  3675. rComplete(tempR);
  3676. ideal vid = (ideal)v->Data();
  3677. int i = idPosConstant(vid);
  3678. if ((i != -1) && (nIsUnit(pGetCoeff(vid->m[i]))))
  3679. { /* ideal v contains unit; dim = -1 */
  3680. res->data = (char *)-1;
  3681. return FALSE;
  3682. }
  3683. rChangeCurrRing(tempR);
  3684. ideal vv = idrCopyR(vid, origR, currRing);
  3685. /* drop degree zero generator from vv (if any) */
  3686. if (i != -1) pDelete(&vv->m[i]);
  3687. long d = (long)scDimInt(vv, currQuotient);
  3688. if (rField_is_Ring_Z(origR) && (i == -1)) d++;
  3689. res->data = (char *)d;
  3690. idDelete(&vv);
  3691. rChangeCurrRing(origR);
  3692. rDelete(tempR);
  3693. return FALSE;
  3694. }
  3695. #endif
  3696. res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
  3697. return FALSE;
  3698. }
  3699. static BOOLEAN jjDUMP(leftv res, leftv v)
  3700. {
  3701. si_link l = (si_link)v->Data();
  3702. if (slDump(l))
  3703. {
  3704. const char *s;
  3705. if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
  3706. else s=sNoName;
  3707. Werror("cannot dump to `%s`",s);
  3708. return TRUE;
  3709. }
  3710. else
  3711. return FALSE;
  3712. }
  3713. static BOOLEAN jjE(leftv res, leftv v)
  3714. {
  3715. res->data = (char *)pOne();
  3716. int co=(int)(long)v->Data();
  3717. if (co>0)
  3718. {
  3719. pSetComp((poly)res->data,co);
  3720. pSetm((poly)res->data);
  3721. }
  3722. else WerrorS("argument of gen must be positive");
  3723. return (co<=0);
  3724. }
  3725. static BOOLEAN jjEXECUTE(leftv res, leftv v)
  3726. {
  3727. char * d = (char *)v->Data();
  3728. char * s = (char *)omAlloc(strlen(d) + 13);
  3729. strcpy( s, (char *)d);
  3730. strcat( s, "\n;RETURN();\n");
  3731. newBuffer(s,BT_execute);
  3732. return yyparse();
  3733. }
  3734. #ifdef HAVE_FACTORY
  3735. static BOOLEAN jjFACSTD(leftv res, leftv v)
  3736. {
  3737. ideal_list p,h;
  3738. h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
  3739. lists L=(lists)omAllocBin(slists_bin);
  3740. if (h==NULL)
  3741. {
  3742. L->Init(1);
  3743. L->m[0].data=(char *)idInit(0,1);
  3744. L->m[0].rtyp=IDEAL_CMD;
  3745. }
  3746. else
  3747. {
  3748. p=h;
  3749. int l=0;
  3750. while (p!=NULL) { p=p->next;l++; }
  3751. L->Init(l);
  3752. l=0;
  3753. while(h!=NULL)
  3754. {
  3755. L->m[l].data=(char *)h->d;
  3756. L->m[l].rtyp=IDEAL_CMD;
  3757. p=h->next;
  3758. omFreeSize(h,sizeof(*h));
  3759. h=p;
  3760. l++;
  3761. }
  3762. }
  3763. res->data=(void *)L;
  3764. return FALSE;
  3765. }
  3766. static BOOLEAN jjFAC_P(leftv res, leftv u)
  3767. {
  3768. intvec *v=NULL;
  3769. singclap_factorize_retry=0;
  3770. ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
  3771. if (f==NULL) return TRUE;
  3772. ivTest(v);
  3773. lists l=(lists)omAllocBin(slists_bin);
  3774. l->Init(2);
  3775. l->m[0].rtyp=IDEAL_CMD;
  3776. l->m[0].data=(void *)f;
  3777. l->m[1].rtyp=INTVEC_CMD;
  3778. l->m[1].data=(void *)v;
  3779. res->data=(void *)l;
  3780. return FALSE;
  3781. }
  3782. #endif
  3783. static BOOLEAN jjGETDUMP(leftv res, leftv v)
  3784. {
  3785. si_link l = (si_link)v->Data();
  3786. if (slGetDump(l))
  3787. {
  3788. const char *s;
  3789. if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
  3790. else s=sNoName;
  3791. Werror("cannot get dump from `%s`",s);
  3792. return TRUE;
  3793. }
  3794. else
  3795. return FALSE;
  3796. }
  3797. static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
  3798. {
  3799. assumeStdFlag(v);
  3800. ideal I=(ideal)v->Data();
  3801. res->data=(void *)iiHighCorner(I,0);
  3802. return FALSE;
  3803. }
  3804. static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
  3805. {
  3806. assumeStdFlag(v);
  3807. intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  3808. BOOLEAN delete_w=FALSE;
  3809. ideal I=(ideal)v->Data();
  3810. int i;
  3811. poly p=NULL,po=NULL;
  3812. int rk=idRankFreeModule(I);
  3813. if (w==NULL)
  3814. {
  3815. w = new intvec(rk);
  3816. delete_w=TRUE;
  3817. }
  3818. for(i=rk;i>0;i--)
  3819. {
  3820. p=iiHighCorner(I,i);
  3821. if (p==NULL)
  3822. {
  3823. WerrorS("module must be zero-dimensional");
  3824. if (delete_w) delete w;
  3825. return TRUE;
  3826. }
  3827. if (po==NULL)
  3828. {
  3829. po=p;
  3830. }
  3831. else
  3832. {
  3833. // now po!=NULL, p!=NULL
  3834. int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
  3835. if (d==0)
  3836. d=pLmCmp(po,p);
  3837. if (d > 0)
  3838. {
  3839. pDelete(&p);
  3840. }
  3841. else // (d < 0)
  3842. {
  3843. pDelete(&po); po=p;
  3844. }
  3845. }
  3846. }
  3847. if (delete_w) delete w;
  3848. res->data=(void *)po;
  3849. return FALSE;
  3850. }
  3851. static BOOLEAN jjHILBERT(leftv res, leftv v)
  3852. {
  3853. #ifdef HAVE_RINGS
  3854. if (rField_is_Ring_Z(currRing))
  3855. {
  3856. ring origR = currRing;
  3857. ring tempR = rCopy(origR);
  3858. tempR->ringtype = 0; tempR->ch = 0;
  3859. rComplete(tempR);
  3860. ideal vid = (ideal)v->Data();
  3861. rChangeCurrRing(tempR);
  3862. ideal vv = idrCopyR(vid, origR, currRing);
  3863. sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
  3864. vvAsLeftv.rtyp = IDEAL_CMD;
  3865. vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
  3866. if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
  3867. assumeStdFlag(&vvAsLeftv);
  3868. Print("// NOTE: computation of Hilbert series etc. is being\n");
  3869. Print("// performed for generic fibre, that is, over Q\n");
  3870. intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
  3871. //scHilbertPoly(vv,currQuotient);
  3872. hLookSeries(vv,module_w,currQuotient);
  3873. idDelete(&vv);
  3874. rChangeCurrRing(origR);
  3875. rDelete(tempR);
  3876. return FALSE;
  3877. }
  3878. #endif
  3879. assumeStdFlag(v);
  3880. intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  3881. //scHilbertPoly((ideal)v->Data(),currQuotient);
  3882. hLookSeries((ideal)v->Data(),module_w,currQuotient);
  3883. return FALSE;
  3884. }
  3885. static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
  3886. {
  3887. #ifdef HAVE_RINGS
  3888. if (rField_is_Ring_Z(currRing))
  3889. {
  3890. Print("// NOTE: computation of Hilbert series etc. is being\n");
  3891. Print("// performed for generic fibre, that is, over Q\n");
  3892. }
  3893. #endif
  3894. res->data=(void *)hSecondSeries((intvec *)v->Data());
  3895. return FALSE;
  3896. }
  3897. static BOOLEAN jjHOMOG1(leftv res, leftv v)
  3898. {
  3899. intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  3900. ideal v_id=(ideal)v->Data();
  3901. if (w==NULL)
  3902. {
  3903. res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
  3904. if (res->data!=NULL)
  3905. {
  3906. if (v->rtyp==IDHDL)
  3907. {
  3908. char *s_isHomog=omStrDup("isHomog");
  3909. if (v->e==NULL)
  3910. atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
  3911. else
  3912. atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
  3913. }
  3914. else if (w!=NULL) delete w;
  3915. } // if res->data==NULL then w==NULL
  3916. }
  3917. else
  3918. {
  3919. res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
  3920. if((res->data==NULL) && (v->rtyp==IDHDL))
  3921. {
  3922. if (v->e==NULL)
  3923. atKill((idhdl)(v->data),"isHomog");
  3924. else
  3925. atKill((idhdl)(v->LData()),"isHomog");
  3926. }
  3927. }
  3928. return FALSE;
  3929. }
  3930. static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
  3931. {
  3932. res->data = (char *)idMaxIdeal((int)(long)v->Data());
  3933. setFlag(res,FLAG_STD);
  3934. return FALSE;
  3935. }
  3936. static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
  3937. {
  3938. matrix mat=(matrix)v->CopyD(MATRIX_CMD);
  3939. IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
  3940. if (IDELEMS((ideal)mat)==0)
  3941. {
  3942. idDelete((ideal *)&mat);
  3943. mat=(matrix)idInit(1,1);
  3944. }
  3945. else
  3946. {
  3947. MATROWS(mat)=1;
  3948. mat->rank=1;
  3949. idTest((ideal)mat);
  3950. }
  3951. res->data=(char *)mat;
  3952. return FALSE;
  3953. }
  3954. static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
  3955. {
  3956. map m=(map)v->CopyD(MAP_CMD);
  3957. omFree((ADDRESS)m->preimage);
  3958. m->preimage=NULL;
  3959. ideal I=(ideal)m;
  3960. I->rank=1;
  3961. res->data=(char *)I;
  3962. return FALSE;
  3963. }
  3964. static BOOLEAN jjIDEAL_R(leftv res, leftv v)
  3965. {
  3966. if (currRing!=NULL)
  3967. {
  3968. ring q=(ring)v->Data();
  3969. if (rSamePolyRep(currRing, q))
  3970. {
  3971. if (q->qideal==NULL)
  3972. res->data=(char *)idInit(1,1);
  3973. else
  3974. res->data=(char *)idCopy(q->qideal);
  3975. return FALSE;
  3976. }
  3977. }
  3978. WerrorS("can only get ideal from identical qring");
  3979. return TRUE;
  3980. }
  3981. static BOOLEAN jjIm2Iv(leftv res, leftv v)
  3982. {
  3983. intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
  3984. iv->makeVector();
  3985. res->data = iv;
  3986. return FALSE;
  3987. }
  3988. static BOOLEAN jjIMPART(leftv res, leftv v)
  3989. {
  3990. res->data = (char *)nImPart((number)v->Data());
  3991. return FALSE;
  3992. }
  3993. static BOOLEAN jjINDEPSET(leftv res, leftv v)
  3994. {
  3995. assumeStdFlag(v);
  3996. res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
  3997. return FALSE;
  3998. }
  3999. static BOOLEAN jjINTERRED(leftv res, leftv v)
  4000. {
  4001. ideal result=kInterRed((ideal)(v->Data()), currQuotient);
  4002. if (TEST_OPT_PROT) { PrintLn(); mflush(); }
  4003. res->data = result;
  4004. return FALSE;
  4005. }
  4006. static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
  4007. {
  4008. res->data = (char *)(long)pVar((poly)v->Data());
  4009. return FALSE;
  4010. }
  4011. static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
  4012. {
  4013. res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
  4014. return FALSE;
  4015. }
  4016. static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
  4017. {
  4018. res->data = (char *)0;
  4019. return FALSE;
  4020. }
  4021. static BOOLEAN jjJACOB_P(leftv res, leftv v)
  4022. {
  4023. ideal i=idInit(pVariables,1);
  4024. int k;
  4025. poly p=(poly)(v->Data());
  4026. for (k=pVariables;k>0;k--)
  4027. {
  4028. i->m[k-1]=pDiff(p,k);
  4029. }
  4030. res->data = (char *)i;
  4031. return FALSE;
  4032. }
  4033. /*2
  4034. * compute Jacobi matrix of a module/matrix
  4035. * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables)) ),
  4036. * where Mt := transpose(M)
  4037. * Note that this is consistent with the current conventions for jacob in Singular,
  4038. * whereas M2 computes its transposed.
  4039. */
  4040. static BOOLEAN jjJACOB_M(leftv res, leftv a)
  4041. {
  4042. ideal id = (ideal)a->Data();
  4043. id = idTransp(id);
  4044. int W = IDELEMS(id);
  4045. ideal result = idInit(W * pVariables, id->rank);
  4046. poly *p = result->m;
  4047. for( int v = 1; v <= pVariables; v++ )
  4048. {
  4049. poly* q = id->m;
  4050. for( int i = 0; i < W; i++, p++, q++ )
  4051. *p = pDiff( *q, v );
  4052. }
  4053. idDelete(&id);
  4054. res->data = (char *)result;
  4055. return FALSE;
  4056. }
  4057. static BOOLEAN jjKBASE(leftv res, leftv v)
  4058. {
  4059. assumeStdFlag(v);
  4060. res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
  4061. return FALSE;
  4062. }
  4063. #ifdef MDEBUG
  4064. static BOOLEAN jjpHead(leftv res, leftv v)
  4065. {
  4066. res->data=(char *)pHead((poly)v->Data());
  4067. return FALSE;
  4068. }
  4069. #endif
  4070. static BOOLEAN jjL2R(leftv res, leftv v)
  4071. {
  4072. res->data=(char *)syConvList((lists)v->Data());
  4073. if (res->data != NULL)
  4074. return FALSE;
  4075. else
  4076. return TRUE;
  4077. }
  4078. static BOOLEAN jjLEADCOEF(leftv res, leftv v)
  4079. {
  4080. poly p=(poly)v->Data();
  4081. if (p==NULL)
  4082. {
  4083. res->data=(char *)nInit(0);
  4084. }
  4085. else
  4086. {
  4087. res->data=(char *)nCopy(pGetCoeff(p));
  4088. }
  4089. return FALSE;
  4090. }
  4091. static BOOLEAN jjLEADEXP(leftv res, leftv v)
  4092. {
  4093. poly p=(poly)v->Data();
  4094. int s=pVariables;
  4095. if (v->Typ()==VECTOR_CMD) s++;
  4096. intvec *iv=new intvec(s);
  4097. if (p!=NULL)
  4098. {
  4099. for(int i = pVariables;i;i--)
  4100. {
  4101. (*iv)[i-1]=pGetExp(p,i);
  4102. }
  4103. if (s!=pVariables)
  4104. (*iv)[pVariables]=pGetComp(p);
  4105. }
  4106. res->data=(char *)iv;
  4107. return FALSE;
  4108. }
  4109. static BOOLEAN jjLEADMONOM(leftv res, leftv v)
  4110. {
  4111. poly p=(poly)v->Data();
  4112. if (p == NULL)
  4113. {
  4114. res->data = (char*) NULL;
  4115. }
  4116. else
  4117. {
  4118. poly lm = pLmInit(p);
  4119. pSetCoeff(lm, nInit(1));
  4120. res->data = (char*) lm;
  4121. }
  4122. return FALSE;
  4123. }
  4124. static BOOLEAN jjLOAD1(leftv res, leftv v)
  4125. {
  4126. return jjLOAD(res, v,FALSE);
  4127. }
  4128. static BOOLEAN jjLISTRING(leftv res, leftv v)
  4129. {
  4130. ring r=rCompose((lists)v->Data());
  4131. if (r==NULL) return TRUE;
  4132. if (r->qideal!=NULL) res->rtyp=QRING_CMD;
  4133. res->data=(char *)r;
  4134. return FALSE;
  4135. }
  4136. #if SIZEOF_LONG == 8
  4137. static number jjLONG2N(long d)
  4138. {
  4139. int i=(int)d;
  4140. if ((long)i == d)
  4141. {
  4142. return nlInit(i, NULL);
  4143. }
  4144. else
  4145. {
  4146. #if !defined(OM_NDEBUG) && !defined(NDEBUG)
  4147. omCheckBin(rnumber_bin);
  4148. #endif
  4149. number z=(number)omAllocBin(rnumber_bin);
  4150. #if defined(LDEBUG)
  4151. z->debug=123456;
  4152. #endif
  4153. z->s=3;
  4154. mpz_init_set_si(z->z,d);
  4155. return z;
  4156. }
  4157. }
  4158. #else
  4159. #define jjLONG2N(D) nlInit((int)D, NULL)
  4160. #endif
  4161. static BOOLEAN jjPFAC1(leftv res, leftv v)
  4162. {
  4163. /* call method jjPFAC2 with second argument = 0 (meaning that no
  4164. valid bound for the prime factors has been given) */
  4165. sleftv tmp;
  4166. memset(&tmp, 0, sizeof(tmp));
  4167. tmp.rtyp = INT_CMD;
  4168. return jjPFAC2(res, v, &tmp);
  4169. }
  4170. static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
  4171. {
  4172. /* computes the LU-decomposition of a matrix M;
  4173. i.e., M = P * L * U, where
  4174. - P is a row permutation matrix,
  4175. - L is in lower triangular form,
  4176. - U is in upper row echelon form
  4177. Then, we also have P * M = L * U.
  4178. A list [P, L, U] is returned. */
  4179. matrix mat = (const matrix)v->Data();
  4180. int rr = mat->rows();
  4181. int cc = mat->cols();
  4182. matrix pMat;
  4183. matrix lMat;
  4184. matrix uMat;
  4185. luDecomp(mat, pMat, lMat, uMat);
  4186. lists ll = (lists)omAllocBin(slists_bin);
  4187. ll->Init(3);
  4188. ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
  4189. ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
  4190. ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
  4191. res->data=(char*)ll;
  4192. return FALSE;
  4193. }
  4194. static BOOLEAN jjMEMORY(leftv res, leftv v)
  4195. {
  4196. omUpdateInfo();
  4197. long d;
  4198. switch(((int)(long)v->Data()))
  4199. {
  4200. case 0:
  4201. res->data=(char *)jjLONG2N(om_Info.UsedBytes);
  4202. break;
  4203. case 1:
  4204. res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
  4205. break;
  4206. case 2:
  4207. res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
  4208. break;
  4209. default:
  4210. omPrintStats(stdout);
  4211. omPrintInfo(stdout);
  4212. omPrintBinStats(stdout);
  4213. res->data = (char *)0;
  4214. res->rtyp = NONE;
  4215. }
  4216. return FALSE;
  4217. res->data = (char *)0;
  4218. return FALSE;
  4219. }
  4220. //static BOOLEAN jjMONITOR1(leftv res, leftv v)
  4221. //{
  4222. // return jjMONITOR2(res,v,NULL);
  4223. //}
  4224. static BOOLEAN jjMSTD(leftv res, leftv v)
  4225. {
  4226. int t=v->Typ();
  4227. ideal r,m;
  4228. r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
  4229. lists l=(lists)omAllocBin(slists_bin);
  4230. l->Init(2);
  4231. l->m[0].rtyp=t;
  4232. l->m[0].data=(char *)r;
  4233. setFlag(&(l->m[0]),FLAG_STD);
  4234. l->m[1].rtyp=t;
  4235. l->m[1].data=(char *)m;
  4236. res->data=(char *)l;
  4237. return FALSE;
  4238. }
  4239. static BOOLEAN jjMULT(leftv res, leftv v)
  4240. {
  4241. assumeStdFlag(v);
  4242. res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
  4243. return FALSE;
  4244. }
  4245. static BOOLEAN jjMINRES_R(leftv res, leftv v)
  4246. {
  4247. intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  4248. syStrategy tmp=(syStrategy)v->Data();
  4249. tmp = syMinimize(tmp); // enrich itself!
  4250. res->data=(char *)tmp;
  4251. if (weights!=NULL)
  4252. atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
  4253. return FALSE;
  4254. }
  4255. static BOOLEAN jjN2BI(leftv res, leftv v)
  4256. {
  4257. number n,i; i=(number)v->Data();
  4258. if (rField_is_Zp())
  4259. {
  4260. n=nlInit(npInt(i,currRing),NULL);
  4261. }
  4262. else if (rField_is_Q()) n=nlBigInt(i);
  4263. #ifdef HAVE_RINGS
  4264. else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
  4265. else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
  4266. #endif
  4267. else goto err;
  4268. res->data=(void *)n;
  4269. return FALSE;
  4270. err:
  4271. WerrorS("cannot convert to bigint"); return TRUE;
  4272. }
  4273. static BOOLEAN jjNAMEOF(leftv res, leftv v)
  4274. {
  4275. res->data = (char *)v->name;
  4276. if (res->data==NULL) res->data=omStrDup("");
  4277. v->name=NULL;
  4278. return FALSE;
  4279. }
  4280. static BOOLEAN jjNAMES(leftv res, leftv v)
  4281. {
  4282. res->data=ipNameList(((ring)v->Data())->idroot);
  4283. return FALSE;
  4284. }
  4285. static BOOLEAN jjNVARS(leftv res, leftv v)
  4286. {
  4287. res->data = (char *)(long)(((ring)(v->Data()))->N);
  4288. return FALSE;
  4289. }
  4290. static BOOLEAN jjOpenClose(leftv res, leftv v)
  4291. {
  4292. si_link l=(si_link)v->Data();
  4293. if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
  4294. else return slClose(l);
  4295. }
  4296. static BOOLEAN jjORD(leftv res, leftv v)
  4297. {
  4298. poly p=(poly)v->Data();
  4299. res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
  4300. return FALSE;
  4301. }
  4302. static BOOLEAN jjPAR1(leftv res, leftv v)
  4303. {
  4304. int i=(int)(long)v->Data();
  4305. int p=0;
  4306. p=rPar(currRing);
  4307. if ((0<i) && (i<=p))
  4308. {
  4309. res->data=(char *)nPar(i);
  4310. }
  4311. else
  4312. {
  4313. Werror("par number %d out of range 1..%d",i,p);
  4314. return TRUE;
  4315. }
  4316. return FALSE;
  4317. }
  4318. static BOOLEAN jjPARDEG(leftv res, leftv v)
  4319. {
  4320. res->data = (char *)(long)nParDeg((number)v->Data());
  4321. return FALSE;
  4322. }
  4323. static BOOLEAN jjPARSTR1(leftv res, leftv v)
  4324. {
  4325. if (currRing==NULL)
  4326. {
  4327. WerrorS("no ring active");
  4328. return TRUE;
  4329. }
  4330. int i=(int)(long)v->Data();
  4331. int p=0;
  4332. if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
  4333. res->data=omStrDup(currRing->parameter[i-1]);
  4334. else
  4335. {
  4336. Werror("par number %d out of range 1..%d",i,p);
  4337. return TRUE;
  4338. }
  4339. return FALSE;
  4340. }
  4341. static BOOLEAN jjP2BI(leftv res, leftv v)
  4342. {
  4343. poly p=(poly)v->Data();
  4344. if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
  4345. if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
  4346. {
  4347. WerrorS("poly must be constant");
  4348. return TRUE;
  4349. }
  4350. number i=pGetCoeff(p);
  4351. number n;
  4352. if (rField_is_Zp())
  4353. {
  4354. n=nlInit(npInt(i,currRing), NULL);
  4355. }
  4356. else if (rField_is_Q()) n=nlBigInt(i);
  4357. #ifdef HAVE_RINGS
  4358. else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
  4359. n=nlMapGMP(i);
  4360. else if (rField_is_Ring_2toM())
  4361. n=nlInit((unsigned long) i, NULL);
  4362. #endif
  4363. else goto err;
  4364. res->data=(void *)n;
  4365. return FALSE;
  4366. err:
  4367. WerrorS("cannot convert to bigint"); return TRUE;
  4368. }
  4369. static BOOLEAN jjP2I(leftv res, leftv v)
  4370. {
  4371. poly p=(poly)v->Data();
  4372. if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
  4373. if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
  4374. {
  4375. WerrorS("poly must be constant");
  4376. return TRUE;
  4377. }
  4378. res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
  4379. return FALSE;
  4380. }
  4381. static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
  4382. {
  4383. map mapping=(map)v->Data();
  4384. syMake(res,omStrDup(mapping->preimage));
  4385. return FALSE;
  4386. }
  4387. static BOOLEAN jjPRIME(leftv res, leftv v)
  4388. {
  4389. int i = IsPrime((int)(long)(v->Data()));
  4390. res->data = (char *)(long)(i > 1 ? i : 2);
  4391. return FALSE;
  4392. }
  4393. static BOOLEAN jjPRUNE(leftv res, leftv v)
  4394. {
  4395. intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
  4396. ideal v_id=(ideal)v->Data();
  4397. if (w!=NULL)
  4398. {
  4399. if (!idTestHomModule(v_id,currQuotient,w))
  4400. {
  4401. WarnS("wrong weights");
  4402. w=NULL;
  4403. // and continue at the non-homog case below
  4404. }
  4405. else
  4406. {
  4407. w=ivCopy(w);
  4408. intvec **ww=&w;
  4409. res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
  4410. atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
  4411. return FALSE;
  4412. }
  4413. }
  4414. res->data = (char *)idMinEmbedding(v_id);
  4415. return FALSE;
  4416. }
  4417. static BOOLEAN jjP2N(leftv res, leftv v)
  4418. {
  4419. number n;
  4420. poly p;
  4421. if (((p=(poly)v->Data())!=NULL)
  4422. && (pIsConstant(p)))
  4423. {
  4424. n=nCopy(pGetCoeff(p));
  4425. }
  4426. else
  4427. {
  4428. n=nInit(0);
  4429. }
  4430. res->data = (char *)n;
  4431. return FALSE;
  4432. }
  4433. static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
  4434. {
  4435. char *s= (char *)v->Data();
  4436. int i = 1;
  4437. int l = strlen(s);
  4438. for(i=0; i<sArithBase.nCmdUsed; i++)
  4439. {
  4440. //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
  4441. if (strcmp(s, sArithBase.sCmds[i].name) == 0)
  4442. {
  4443. res->data = (char *)1;
  4444. return FALSE;
  4445. }
  4446. }
  4447. //res->data = (char *)0;
  4448. return FALSE;
  4449. }
  4450. static BOOLEAN jjRANK1(leftv res, leftv v)
  4451. {
  4452. matrix m =(matrix)v->Data();
  4453. int rank = luRank(m, 0);
  4454. res->data =(char *)(long)rank;
  4455. return FALSE;
  4456. }
  4457. static BOOLEAN jjREAD(leftv res, leftv v)
  4458. {
  4459. return jjREAD2(res,v,NULL);
  4460. }
  4461. static BOOLEAN jjREGULARITY(leftv res, leftv v)
  4462. {
  4463. res->data = (char *)(long)iiRegularity((lists)v->Data());
  4464. return FALSE;
  4465. }
  4466. static BOOLEAN jjREPART(leftv res, leftv v)
  4467. {
  4468. res->data = (char *)nRePart((number)v->Data());
  4469. return FALSE;
  4470. }
  4471. static BOOLEAN jjRINGLIST(leftv res, leftv v)
  4472. {
  4473. ring r=(ring)v->Data();
  4474. if (r!=NULL)
  4475. res->data = (char *)rDecompose((ring)v->Data());
  4476. return (r==NULL)||(res->data==NULL);
  4477. }
  4478. static BOOLEAN jjROWS(leftv res, leftv v)
  4479. {
  4480. ideal i = (ideal)v->Data();
  4481. res->data = (char *)i->rank;
  4482. return FALSE;
  4483. }
  4484. static BOOLEAN jjROWS_IV(leftv res, leftv v)
  4485. {
  4486. res->data = (char *)(long)((intvec*)(v->Data()))->rows();
  4487. return FALSE;
  4488. }
  4489. static BOOLEAN jjRPAR(leftv res, leftv v)
  4490. {
  4491. res->data = (char *)(long)rPar(((ring)v->Data()));
  4492. return FALSE;
  4493. }
  4494. static BOOLEAN jjSLIM_GB(leftv res, leftv u)
  4495. {
  4496. #ifdef HAVE_PLURAL
  4497. const bool bIsSCA = rIsSCA(currRing);
  4498. #else
  4499. const bool bIsSCA = false;
  4500. #endif
  4501. if ((currQuotient!=NULL) && !bIsSCA)
  4502. {
  4503. WerrorS("qring not supported by slimgb at the moment");
  4504. return TRUE;
  4505. }
  4506. if (rHasLocalOrMixedOrdering_currRing())
  4507. {
  4508. WerrorS("ordering must be global for slimgb");
  4509. return TRUE;
  4510. }
  4511. intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  4512. tHomog hom=testHomog;
  4513. ideal u_id=(ideal)u->Data();
  4514. if (w!=NULL)
  4515. {
  4516. if (!idTestHomModule(u_id,currQuotient,w))
  4517. {
  4518. WarnS("wrong weights");
  4519. w=NULL;
  4520. }
  4521. else
  4522. {
  4523. w=ivCopy(w);
  4524. hom=isHomog;
  4525. }
  4526. }
  4527. assume(u_id->rank>=idRankFreeModule(u_id));
  4528. res->data=(char *)t_rep_gb(currRing,
  4529. u_id,u_id->rank);
  4530. //res->data=(char *)t_rep_gb(currRing, u_id);
  4531. if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
  4532. if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
  4533. return FALSE;
  4534. }
  4535. static BOOLEAN jjSTD(leftv res, leftv v)
  4536. {
  4537. ideal result;
  4538. ideal v_id=(ideal)v->Data();
  4539. intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
  4540. tHomog hom=testHomog;
  4541. if (w!=NULL)
  4542. {
  4543. if (!idTestHomModule(v_id,currQuotient,w))
  4544. {
  4545. WarnS("wrong weights");
  4546. w=NULL;
  4547. }
  4548. else
  4549. {
  4550. hom=isHomog;
  4551. w=ivCopy(w);
  4552. }
  4553. }
  4554. result=kStd(v_id,currQuotient,hom,&w);
  4555. idSkipZeroes(result);
  4556. res->data = (char *)result;
  4557. if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
  4558. if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
  4559. return FALSE;
  4560. }
  4561. static BOOLEAN jjSort_Id(leftv res, leftv v)
  4562. {
  4563. res->data = (char *)idSort((ideal)v->Data());
  4564. return FALSE;
  4565. }
  4566. #ifdef HAVE_FACTORY
  4567. extern int singclap_factorize_retry;
  4568. static BOOLEAN jjSQR_FREE(leftv res, leftv u)
  4569. {
  4570. intvec *v=NULL;
  4571. singclap_factorize_retry=0;
  4572. ideal f=singclap_sqrfree((poly)(u->CopyD()));
  4573. if (f==NULL)
  4574. return TRUE;
  4575. res->data=(void *)f;
  4576. return FALSE;
  4577. }
  4578. #endif
  4579. #if 1
  4580. static BOOLEAN jjSYZYGY(leftv res, leftv v)
  4581. {
  4582. intvec *w=NULL;
  4583. res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
  4584. if (w!=NULL) delete w;
  4585. return FALSE;
  4586. }
  4587. #else
  4588. // activate, if idSyz handle module weights correctly !
  4589. static BOOLEAN jjSYZYGY(leftv res, leftv v)
  4590. {
  4591. intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
  4592. ideal v_id=(ideal)v->Data();
  4593. tHomog hom=testHomog;
  4594. int add_row_shift=0;
  4595. if (w!=NULL)
  4596. {
  4597. w=ivCopy(w);
  4598. add_row_shift=w->min_in();
  4599. (*w)-=add_row_shift;
  4600. if (idTestHomModule(v_id,currQuotient,w))
  4601. hom=isHomog;
  4602. else
  4603. {
  4604. //WarnS("wrong weights");
  4605. delete w; w=NULL;
  4606. hom=testHomog;
  4607. }
  4608. }
  4609. res->data = (char *)idSyzygies(v_id,hom,&w);
  4610. if (w!=NULL)
  4611. {
  4612. atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
  4613. }
  4614. return FALSE;
  4615. }
  4616. #endif
  4617. static BOOLEAN jjTRACE_IV(leftv res, leftv v)
  4618. {
  4619. res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
  4620. return FALSE;
  4621. }
  4622. static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
  4623. {
  4624. res->data = (char *)ivTranp((intvec*)(v->Data()));
  4625. return FALSE;
  4626. }
  4627. #ifdef HAVE_PLURAL
  4628. static BOOLEAN jjOPPOSITE(leftv res, leftv a)
  4629. {
  4630. ring r = (ring)a->Data();
  4631. //if (rIsPluralRing(r))
  4632. if (r->OrdSgn==1)
  4633. {
  4634. res->data = rOpposite(r);
  4635. }
  4636. else
  4637. {
  4638. WarnS("opposite only for global orderings");
  4639. res->data = rCopy(r);
  4640. }
  4641. return FALSE;
  4642. }
  4643. static BOOLEAN jjENVELOPE(leftv res, leftv a)
  4644. {
  4645. ring r = (ring)a->Data();
  4646. if (rIsPluralRing(r))
  4647. {
  4648. // ideal i;
  4649. // if (a->rtyp == QRING_CMD)
  4650. // {
  4651. // i = r->qideal;
  4652. // r->qideal = NULL;
  4653. // }
  4654. ring s = rEnvelope(r);
  4655. // if (a->rtyp == QRING_CMD)
  4656. // {
  4657. // ideal is = idOppose(r,i); /* twostd? */
  4658. // is = idAdd(is,i);
  4659. // s->qideal = i;
  4660. // }
  4661. res->data = s;
  4662. }
  4663. else res->data = rCopy(r);
  4664. return FALSE;
  4665. }
  4666. static BOOLEAN jjTWOSTD(leftv res, leftv a)
  4667. {
  4668. if (rIsPluralRing(currRing)) res->data=(ideal)twostd((ideal)a->Data());
  4669. else res->data=(ideal)a->CopyD();
  4670. setFlag(res,FLAG_STD);
  4671. setFlag(res,FLAG_TWOSTD);
  4672. return FALSE;
  4673. }
  4674. #endif
  4675. static BOOLEAN jjTYPEOF(leftv res, leftv v)
  4676. {
  4677. int t=(int)(long)v->data;
  4678. switch (t)
  4679. {
  4680. case INT_CMD: res->data=omStrDup("int"); break;
  4681. case POLY_CMD: res->data=omStrDup("poly"); break;
  4682. case VECTOR_CMD: res->data=omStrDup("vector"); break;
  4683. case STRING_CMD: res->data=omStrDup("string"); break;
  4684. case INTVEC_CMD: res->data=omStrDup("intvec"); break;
  4685. case IDEAL_CMD: res->data=omStrDup("ideal"); break;
  4686. case MATRIX_CMD: res->data=omStrDup("matrix"); break;
  4687. case MODUL_CMD: res->data=omStrDup("module"); break;
  4688. case MAP_CMD: res->data=omStrDup("map"); break;
  4689. case PROC_CMD: res->data=omStrDup("proc"); break;
  4690. case RING_CMD: res->data=omStrDup("ring"); break;
  4691. case QRING_CMD: res->data=omStrDup("qring"); break;
  4692. case INTMAT_CMD: res->data=omStrDup("intmat"); break;
  4693. case NUMBER_CMD: res->data=omStrDup("number"); break;
  4694. case BIGINT_CMD: res->data=omStrDup("bigint"); break;
  4695. case LIST_CMD: res->data=omStrDup("list"); break;
  4696. case PACKAGE_CMD: res->data=omStrDup("package"); break;
  4697. case LINK_CMD: res->data=omStrDup("link"); break;
  4698. case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
  4699. case DEF_CMD:
  4700. case NONE: res->data=omStrDup("none"); break;
  4701. default:
  4702. {
  4703. if (t>MAX_TOK)
  4704. res->data=omStrDup(getBlackboxName(t));
  4705. else
  4706. res->data=omStrDup("?unknown type?");
  4707. break;
  4708. }
  4709. }
  4710. return FALSE;
  4711. }
  4712. static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
  4713. {
  4714. res->data=(char *)pIsUnivariate((poly)v->Data());
  4715. return FALSE;
  4716. }
  4717. static BOOLEAN jjVAR1(leftv res, leftv v)
  4718. {
  4719. int i=(int)(long)v->Data();
  4720. if ((0<i) && (i<=currRing->N))
  4721. {
  4722. poly p=pOne();
  4723. pSetExp(p,i,1);
  4724. pSetm(p);
  4725. res->data=(char *)p;
  4726. }
  4727. else
  4728. {
  4729. Werror("var number %d out of range 1..%d",i,currRing->N);
  4730. return TRUE;
  4731. }
  4732. return FALSE;
  4733. }
  4734. static BOOLEAN jjVARSTR1(leftv res, leftv v)
  4735. {
  4736. if (currRing==NULL)
  4737. {
  4738. WerrorS("no ring active");
  4739. return TRUE;
  4740. }
  4741. int i=(int)(long)v->Data();
  4742. if ((0<i) && (i<=currRing->N))
  4743. res->data=omStrDup(currRing->names[i-1]);
  4744. else
  4745. {
  4746. Werror("var number %d out of range 1..%d",i,currRing->N);
  4747. return TRUE;
  4748. }
  4749. return FALSE;
  4750. }
  4751. static BOOLEAN jjVDIM(leftv res, leftv v)
  4752. {
  4753. assumeStdFlag(v);
  4754. res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
  4755. return FALSE;
  4756. }
  4757. BOOLEAN jjWAIT1ST1(leftv res, leftv u)
  4758. {
  4759. // input: u: a list with links of type
  4760. // ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
  4761. // returns: -1: the read state of all links is eof
  4762. // i>0: (at least) u[i] is ready
  4763. lists Lforks = (lists)u->Data();
  4764. int i = slStatusSsiL(Lforks, -1);
  4765. if(i == -2) /* error */
  4766. {
  4767. return TRUE;
  4768. }
  4769. res->data = (void*)(long)i;
  4770. return FALSE;
  4771. }
  4772. BOOLEAN jjWAITALL1(leftv res, leftv u)
  4773. {
  4774. // input: u: a list with links of type
  4775. // ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
  4776. // returns: -1: the read state of all links is eof
  4777. // 1: all links are ready
  4778. // (caution: at least one is ready, but some maybe dead)
  4779. lists Lforks = (lists)u->CopyD();
  4780. int i;
  4781. int j = -1;
  4782. for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
  4783. {
  4784. i = slStatusSsiL(Lforks, -1);
  4785. if(i == -2) /* error */
  4786. {
  4787. return TRUE;
  4788. }
  4789. if(i == -1)
  4790. {
  4791. break;
  4792. }
  4793. j = 1;
  4794. Lforks->m[i-1].CleanUp();
  4795. Lforks->m[i-1].rtyp=DEF_CMD;
  4796. Lforks->m[i-1].data=NULL;
  4797. }
  4798. res->data = (void*)(long)j;
  4799. Lforks->Clean();
  4800. return FALSE;
  4801. }
  4802. static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
  4803. {
  4804. char * s=(char *)v->CopyD();
  4805. char libnamebuf[256];
  4806. lib_types LT = type_of_LIB(s, libnamebuf);
  4807. #ifdef HAVE_DYNAMIC_LOADING
  4808. extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
  4809. #endif /* HAVE_DYNAMIC_LOADING */
  4810. switch(LT)
  4811. {
  4812. default:
  4813. case LT_NONE:
  4814. Werror("%s: unknown type", s);
  4815. break;
  4816. case LT_NOTFOUND:
  4817. Werror("cannot open %s", s);
  4818. break;
  4819. case LT_SINGULAR:
  4820. {
  4821. char *plib = iiConvName(s);
  4822. idhdl pl = IDROOT->get(plib,0);
  4823. if (pl==NULL)
  4824. {
  4825. pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
  4826. IDPACKAGE(pl)->language = LANG_SINGULAR;
  4827. IDPACKAGE(pl)->libname=omStrDup(plib);
  4828. }
  4829. else if (IDTYP(pl)!=PACKAGE_CMD)
  4830. {
  4831. Werror("can not create package `%s`",plib);
  4832. omFree(plib);
  4833. return TRUE;
  4834. }
  4835. package savepack=currPack;
  4836. currPack=IDPACKAGE(pl);
  4837. IDPACKAGE(pl)->loaded=TRUE;
  4838. char libnamebuf[256];
  4839. FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
  4840. BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
  4841. currPack=savepack;
  4842. IDPACKAGE(pl)->loaded=(!bo);
  4843. return bo;
  4844. }
  4845. case LT_MACH_O:
  4846. case LT_ELF:
  4847. case LT_HPUX:
  4848. #ifdef HAVE_DYNAMIC_LOADING
  4849. return load_modules(s, libnamebuf, autoexport);
  4850. #else /* HAVE_DYNAMIC_LOADING */
  4851. WerrorS("Dynamic modules are not supported by this version of Singular");
  4852. break;
  4853. #endif /* HAVE_DYNAMIC_LOADING */
  4854. }
  4855. return TRUE;
  4856. }
  4857. #ifdef INIT_BUG
  4858. #define XS(A) -((short)A)
  4859. #define jjstrlen (proc1)1
  4860. #define jjpLength (proc1)2
  4861. #define jjidElem (proc1)3
  4862. #define jjmpDetBareiss (proc1)4
  4863. #define jjidFreeModule (proc1)5
  4864. #define jjidVec2Ideal (proc1)6
  4865. #define jjrCharStr (proc1)7
  4866. #ifndef MDEBUG
  4867. #define jjpHead (proc1)8
  4868. #endif
  4869. #define jjidHead (proc1)9
  4870. #define jjidMinBase (proc1)11
  4871. #define jjsyMinBase (proc1)12
  4872. #define jjpMaxComp (proc1)13
  4873. #define jjmpTrace (proc1)14
  4874. #define jjmpTransp (proc1)15
  4875. #define jjrOrdStr (proc1)16
  4876. #define jjrVarStr (proc1)18
  4877. #define jjrParStr (proc1)19
  4878. #define jjCOUNT_RES (proc1)22
  4879. #define jjDIM_R (proc1)23
  4880. #define jjidTransp (proc1)24
  4881. extern struct sValCmd1 dArith1[];
  4882. void jjInitTab1()
  4883. {
  4884. int i=0;
  4885. for (;dArith1[i].cmd!=0;i++)
  4886. {
  4887. if (dArith1[i].res<0)
  4888. {
  4889. switch ((int)dArith1[i].p)
  4890. {
  4891. case (int)jjstrlen: dArith1[i].p=(proc1)strlen; break;
  4892. case (int)jjpLength: dArith1[i].p=(proc1)pLength; break;
  4893. case (int)jjidElem: dArith1[i].p=(proc1)idElem; break;
  4894. case (int)jjidVec2Ideal: dArith1[i].p=(proc1)idVec2Ideal; break;
  4895. #ifndef HAVE_FACTORY
  4896. case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
  4897. #endif
  4898. case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
  4899. case (int)jjrCharStr: dArith1[i].p=(proc1)rCharStr; break;
  4900. #ifndef MDEBUG
  4901. case (int)jjpHead: dArith1[i].p=(proc1)pHeadProc; break;
  4902. #endif
  4903. case (int)jjidHead: dArith1[i].p=(proc1)idHead; break;
  4904. case (int)jjidMinBase: dArith1[i].p=(proc1)idMinBase; break;
  4905. case (int)jjsyMinBase: dArith1[i].p=(proc1)syMinBase; break;
  4906. case (int)jjpMaxComp: dArith1[i].p=(proc1)pMaxCompProc; break;
  4907. case (int)jjmpTrace: dArith1[i].p=(proc1)mpTrace; break;
  4908. case (int)jjmpTransp: dArith1[i].p=(proc1)mpTransp; break;
  4909. case (int)jjrOrdStr: dArith1[i].p=(proc1)rOrdStr; break;
  4910. case (int)jjrVarStr: dArith1[i].p=(proc1)rVarStr; break;
  4911. case (int)jjrParStr: dArith1[i].p=(proc1)rParStr; break;
  4912. case (int)jjCOUNT_RES: dArith1[i].p=(proc1)sySize; break;
  4913. case (int)jjDIM_R: dArith1[i].p=(proc1)syDim; break;
  4914. case (int)jjidTransp: dArith1[i].p=(proc1)idTransp; break;
  4915. default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
  4916. }
  4917. }
  4918. }
  4919. }
  4920. #else
  4921. #if defined(PROC_BUG)
  4922. #define XS(A) A
  4923. static BOOLEAN jjstrlen(leftv res, leftv v)
  4924. {
  4925. res->data = (char *)strlen((char *)v->Data());
  4926. return FALSE;
  4927. }
  4928. static BOOLEAN jjpLength(leftv res, leftv v)
  4929. {
  4930. res->data = (char *)pLength((poly)v->Data());
  4931. return FALSE;
  4932. }
  4933. static BOOLEAN jjidElem(leftv res, leftv v)
  4934. {
  4935. res->data = (char *)idElem((ideal)v->Data());
  4936. return FALSE;
  4937. }
  4938. static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
  4939. {
  4940. res->data = (char *)mpDetBareiss((matrix)v->Data());
  4941. return FALSE;
  4942. }
  4943. static BOOLEAN jjidFreeModule(leftv res, leftv v)
  4944. {
  4945. res->data = (char *)idFreeModule((int)(long)v->Data());
  4946. return FALSE;
  4947. }
  4948. static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
  4949. {
  4950. res->data = (char *)idVec2Ideal((poly)v->Data());
  4951. return FALSE;
  4952. }
  4953. static BOOLEAN jjrCharStr(leftv res, leftv v)
  4954. {
  4955. res->data = rCharStr((ring)v->Data());
  4956. return FALSE;
  4957. }
  4958. #ifndef MDEBUG
  4959. static BOOLEAN jjpHead(leftv res, leftv v)
  4960. {
  4961. res->data = (char *)pHead((poly)v->Data());
  4962. return FALSE;
  4963. }
  4964. #endif
  4965. static BOOLEAN jjidHead(leftv res, leftv v)
  4966. {
  4967. res->data = (char *)idHead((ideal)v->Data());
  4968. return FALSE;
  4969. }
  4970. static BOOLEAN jjidMinBase(leftv res, leftv v)
  4971. {
  4972. res->data = (char *)idMinBase((ideal)v->Data());
  4973. return FALSE;
  4974. }
  4975. static BOOLEAN jjsyMinBase(leftv res, leftv v)
  4976. {
  4977. res->data = (char *)syMinBase((ideal)v->Data());
  4978. return FALSE;
  4979. }
  4980. static BOOLEAN jjpMaxComp(leftv res, leftv v)
  4981. {
  4982. res->data = (char *)pMaxComp((poly)v->Data());
  4983. return FALSE;
  4984. }
  4985. static BOOLEAN jjmpTrace(leftv res, leftv v)
  4986. {
  4987. res->data = (char *)mpTrace((matrix)v->Data());
  4988. return FALSE;
  4989. }
  4990. static BOOLEAN jjmpTransp(leftv res, leftv v)
  4991. {
  4992. res->data = (char *)mpTransp((matrix)v->Data());
  4993. return FALSE;
  4994. }
  4995. static BOOLEAN jjrOrdStr(leftv res, leftv v)
  4996. {
  4997. res->data = rOrdStr((ring)v->Data());
  4998. return FALSE;
  4999. }
  5000. static BOOLEAN jjrVarStr(leftv res, leftv v)
  5001. {
  5002. res->data = rVarStr((ring)v->Data());
  5003. return FALSE;
  5004. }
  5005. static BOOLEAN jjrParStr(leftv res, leftv v)
  5006. {
  5007. res->data = rParStr((ring)v->Data());
  5008. return FALSE;
  5009. }
  5010. static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
  5011. {
  5012. res->data=(char *)sySize((syStrategy)v->Data());
  5013. return FALSE;
  5014. }
  5015. static BOOLEAN jjDIM_R(leftv res, leftv v)
  5016. {
  5017. res->data = (char *)syDim((syStrategy)v->Data());
  5018. return FALSE;
  5019. }
  5020. static BOOLEAN jjidTransp(leftv res, leftv v)
  5021. {
  5022. res->data = (char *)idTransp((ideal)v->Data());
  5023. return FALSE;
  5024. }
  5025. #else
  5026. #define XS(A) -((short)A)
  5027. #define jjstrlen (proc1)strlen
  5028. #define jjpLength (proc1)pLength
  5029. #define jjidElem (proc1)idElem
  5030. #define jjmpDetBareiss (proc1)mpDetBareiss
  5031. #define jjidFreeModule (proc1)idFreeModule
  5032. #define jjidVec2Ideal (proc1)idVec2Ideal
  5033. #define jjrCharStr (proc1)rCharStr
  5034. #ifndef MDEBUG
  5035. #define jjpHead (proc1)pHeadProc
  5036. #endif
  5037. #define jjidHead (proc1)idHead
  5038. #define jjidMaxIdeal (proc1)idMaxIdeal
  5039. #define jjidMinBase (proc1)idMinBase
  5040. #define jjsyMinBase (proc1)syMinBase
  5041. #define jjpMaxComp (proc1)pMaxCompProc
  5042. #define jjmpTrace (proc1)mpTrace
  5043. #define jjmpTransp (proc1)mpTransp
  5044. #define jjrOrdStr (proc1)rOrdStr
  5045. #define jjrVarStr (proc1)rVarStr
  5046. #define jjrParStr (proc1)rParStr
  5047. #define jjCOUNT_RES (proc1)sySize
  5048. #define jjDIM_R (proc1)syDim
  5049. #define jjidTransp (proc1)idTransp
  5050. #endif
  5051. #endif
  5052. static BOOLEAN jjnInt(leftv res, leftv u)
  5053. {
  5054. number n=(number)u->Data();
  5055. res->data=(char *)(long)n_Int(n,currRing);
  5056. return FALSE;
  5057. }
  5058. static BOOLEAN jjnlInt(leftv res, leftv u)
  5059. {
  5060. number n=(number)u->Data();
  5061. res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
  5062. return FALSE;
  5063. }
  5064. /*=================== operations with 3 args.: static proc =================*/
  5065. /* must be ordered: first operations for chars (infix ops),
  5066. * then alphabetically */
  5067. static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
  5068. {
  5069. char *s= (char *)u->Data();
  5070. int r = (int)(long)v->Data();
  5071. int c = (int)(long)w->Data();
  5072. int l = strlen(s);
  5073. if ( (r<1) || (r>l) || (c<0) )
  5074. {
  5075. Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
  5076. return TRUE;
  5077. }
  5078. res->data = (char *)omAlloc((long)(c+1));
  5079. sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
  5080. return FALSE;
  5081. }
  5082. static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
  5083. {
  5084. intvec *iv = (intvec *)u->Data();
  5085. int r = (int)(long)v->Data();
  5086. int c = (int)(long)w->Data();
  5087. if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
  5088. {
  5089. Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
  5090. r,c,u->Fullname(),iv->rows(),iv->cols());
  5091. return TRUE;
  5092. }
  5093. res->data=u->data; u->data=NULL;
  5094. res->rtyp=u->rtyp; u->rtyp=0;
  5095. res->name=u->name; u->name=NULL;
  5096. Subexpr e=jjMakeSub(v);
  5097. e->next=jjMakeSub(w);
  5098. if (u->e==NULL) res->e=e;
  5099. else
  5100. {
  5101. Subexpr h=u->e;
  5102. while (h->next!=NULL) h=h->next;
  5103. h->next=e;
  5104. res->e=u->e;
  5105. u->e=NULL;
  5106. }
  5107. return FALSE;
  5108. }
  5109. static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
  5110. {
  5111. matrix m= (matrix)u->Data();
  5112. int r = (int)(long)v->Data();
  5113. int c = (int)(long)w->Data();
  5114. //Print("gen. elem %d, %d\n",r,c);
  5115. if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
  5116. {
  5117. Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
  5118. MATROWS(m),MATCOLS(m));
  5119. return TRUE;
  5120. }
  5121. res->data=u->data; u->data=NULL;
  5122. res->rtyp=u->rtyp; u->rtyp=0;
  5123. res->name=u->name; u->name=NULL;
  5124. Subexpr e=jjMakeSub(v);
  5125. e->next=jjMakeSub(w);
  5126. if (u->e==NULL)
  5127. res->e=e;
  5128. else
  5129. {
  5130. Subexpr h=u->e;
  5131. while (h->next!=NULL) h=h->next;
  5132. h->next=e;
  5133. res->e=u->e;
  5134. u->e=NULL;
  5135. }
  5136. return FALSE;
  5137. }
  5138. static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
  5139. {
  5140. sleftv t;
  5141. sleftv ut;
  5142. leftv p=NULL;
  5143. intvec *iv=(intvec *)w->Data();
  5144. int l;
  5145. BOOLEAN nok;
  5146. if ((u->rtyp!=IDHDL)||(u->e!=NULL))
  5147. {
  5148. WerrorS("cannot build expression lists from unnamed objects");
  5149. return TRUE;
  5150. }
  5151. memcpy(&ut,u,sizeof(ut));
  5152. memset(&t,0,sizeof(t));
  5153. t.rtyp=INT_CMD;
  5154. for (l=0;l< iv->length(); l++)
  5155. {
  5156. t.data=(char *)(long)((*iv)[l]);
  5157. if (p==NULL)
  5158. {
  5159. p=res;
  5160. }
  5161. else
  5162. {
  5163. p->next=(leftv)omAlloc0Bin(sleftv_bin);
  5164. p=p->next;
  5165. }
  5166. memcpy(u,&ut,sizeof(ut));
  5167. if (u->Typ() == MATRIX_CMD)
  5168. nok=jjBRACK_Ma(p,u,v,&t);
  5169. else /* INTMAT_CMD */
  5170. nok=jjBRACK_Im(p,u,v,&t);
  5171. if (nok)
  5172. {
  5173. while (res->next!=NULL)
  5174. {
  5175. p=res->next->next;
  5176. omFreeBin((ADDRESS)res->next, sleftv_bin);
  5177. // res->e aufraeumen !!!!
  5178. res->next=p;
  5179. }
  5180. return TRUE;
  5181. }
  5182. }
  5183. return FALSE;
  5184. }
  5185. static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
  5186. {
  5187. sleftv t;
  5188. sleftv ut;
  5189. leftv p=NULL;
  5190. intvec *iv=(intvec *)v->Data();
  5191. int l;
  5192. BOOLEAN nok;
  5193. if ((u->rtyp!=IDHDL)||(u->e!=NULL))
  5194. {
  5195. WerrorS("cannot build expression lists from unnamed objects");
  5196. return TRUE;
  5197. }
  5198. memcpy(&ut,u,sizeof(ut));
  5199. memset(&t,0,sizeof(t));
  5200. t.rtyp=INT_CMD;
  5201. for (l=0;l< iv->length(); l++)
  5202. {
  5203. t.data=(char *)(long)((*iv)[l]);
  5204. if (p==NULL)
  5205. {
  5206. p=res;
  5207. }
  5208. else
  5209. {
  5210. p->next=(leftv)omAlloc0Bin(sleftv_bin);
  5211. p=p->next;
  5212. }
  5213. memcpy(u,&ut,sizeof(ut));
  5214. if (u->Typ() == MATRIX_CMD)
  5215. nok=jjBRACK_Ma(p,u,&t,w);
  5216. else /* INTMAT_CMD */
  5217. nok=jjBRACK_Im(p,u,&t,w);
  5218. if (nok)
  5219. {
  5220. while (res->next!=NULL)
  5221. {
  5222. p=res->next->next;
  5223. omFreeBin((ADDRESS)res->next, sleftv_bin);
  5224. // res->e aufraeumen !!
  5225. res->next=p;
  5226. }
  5227. return TRUE;
  5228. }
  5229. }
  5230. return FALSE;
  5231. }
  5232. static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
  5233. {
  5234. sleftv t1,t2,ut;
  5235. leftv p=NULL;
  5236. intvec *vv=(intvec *)v->Data();
  5237. intvec *wv=(intvec *)w->Data();
  5238. int vl;
  5239. int wl;
  5240. BOOLEAN nok;
  5241. if ((u->rtyp!=IDHDL)||(u->e!=NULL))
  5242. {
  5243. WerrorS("cannot build expression lists from unnamed objects");
  5244. return TRUE;
  5245. }
  5246. memcpy(&ut,u,sizeof(ut));
  5247. memset(&t1,0,sizeof(sleftv));
  5248. memset(&t2,0,sizeof(sleftv));
  5249. t1.rtyp=INT_CMD;
  5250. t2.rtyp=INT_CMD;
  5251. for (vl=0;vl< vv->length(); vl++)
  5252. {
  5253. t1.data=(char *)(long)((*vv)[vl]);
  5254. for (wl=0;wl< wv->length(); wl++)
  5255. {
  5256. t2.data=(char *)(long)((*wv)[wl]);
  5257. if (p==NULL)
  5258. {
  5259. p=res;
  5260. }
  5261. else
  5262. {
  5263. p->next=(leftv)omAlloc0Bin(sleftv_bin);
  5264. p=p->next;
  5265. }
  5266. memcpy(u,&ut,sizeof(ut));
  5267. if (u->Typ() == MATRIX_CMD)
  5268. nok=jjBRACK_Ma(p,u,&t1,&t2);
  5269. else /* INTMAT_CMD */
  5270. nok=jjBRACK_Im(p,u,&t1,&t2);
  5271. if (nok)
  5272. {
  5273. res->CleanUp();
  5274. return TRUE;
  5275. }
  5276. }
  5277. }
  5278. return FALSE;
  5279. }
  5280. static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
  5281. {
  5282. v->next=(leftv)omAllocBin(sleftv_bin);
  5283. memcpy(v->next,w,sizeof(sleftv));
  5284. memset(w,0,sizeof(sleftv));
  5285. return jjPROC(res,u,v);
  5286. }
  5287. static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
  5288. {
  5289. u->next=(leftv)omAllocBin(sleftv_bin);
  5290. memcpy(u->next,v,sizeof(sleftv));
  5291. u->next->next=(leftv)omAllocBin(sleftv_bin);
  5292. memcpy(u->next->next,w,sizeof(sleftv));
  5293. BOOLEAN r=iiExprArithM(res,u,iiOp);
  5294. v->Init();
  5295. w->Init();
  5296. //w->rtyp=0; w->data=NULL;
  5297. // iiExprArithM did the CleanUp
  5298. return r;
  5299. }
  5300. static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
  5301. {
  5302. intvec *iv;
  5303. ideal m;
  5304. lists l=(lists)omAllocBin(slists_bin);
  5305. int k=(int)(long)w->Data();
  5306. if (k>=0)
  5307. {
  5308. smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
  5309. l->Init(2);
  5310. l->m[0].rtyp=MODUL_CMD;
  5311. l->m[1].rtyp=INTVEC_CMD;
  5312. l->m[0].data=(void *)m;
  5313. l->m[1].data=(void *)iv;
  5314. }
  5315. else
  5316. {
  5317. m=smCallSolv((ideal)u->Data());
  5318. l->Init(1);
  5319. l->m[0].rtyp=IDEAL_CMD;
  5320. l->m[0].data=(void *)m;
  5321. }
  5322. res->data = (char *)l;
  5323. return FALSE;
  5324. }
  5325. static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
  5326. {
  5327. if ((w->rtyp!=IDHDL)||(w->e!=NULL))
  5328. {
  5329. WerrorS("3rd argument must be a name of a matrix");
  5330. return TRUE;
  5331. }
  5332. ideal i=(ideal)u->Data();
  5333. int rank=(int)i->rank;
  5334. BOOLEAN r=jjCOEFFS_Id(res,u,v);
  5335. if (r) return TRUE;
  5336. mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
  5337. return FALSE;
  5338. }
  5339. static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
  5340. {
  5341. res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
  5342. (ideal)(v->Data()),(poly)(w->Data()));
  5343. return FALSE;
  5344. }
  5345. static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
  5346. {
  5347. if ((w->rtyp!=IDHDL)||(w->e!=NULL))
  5348. {
  5349. WerrorS("3rd argument must be a name of a matrix");
  5350. return TRUE;
  5351. }
  5352. // CopyD for POLY_CMD and VECTOR_CMD are identical:
  5353. poly p=(poly)u->CopyD(POLY_CMD);
  5354. ideal i=idInit(1,1);
  5355. i->m[0]=p;
  5356. sleftv t;
  5357. memset(&t,0,sizeof(t));
  5358. t.data=(char *)i;
  5359. t.rtyp=IDEAL_CMD;
  5360. int rank=1;
  5361. if (u->Typ()==VECTOR_CMD)
  5362. {
  5363. i->rank=rank=pMaxComp(p);
  5364. t.rtyp=MODUL_CMD;
  5365. }
  5366. BOOLEAN r=jjCOEFFS_Id(res,&t,v);
  5367. t.CleanUp();
  5368. if (r) return TRUE;
  5369. mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
  5370. return FALSE;
  5371. }
  5372. static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
  5373. {
  5374. res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
  5375. (intvec *)w->Data());
  5376. //setFlag(res,FLAG_STD);
  5377. return FALSE;
  5378. }
  5379. static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
  5380. {
  5381. /*4
  5382. * look for the substring what in the string where
  5383. * starting at position n
  5384. * return the position of the first char of what in where
  5385. * or 0
  5386. */
  5387. int n=(int)(long)w->Data();
  5388. char *where=(char *)u->Data();
  5389. char *what=(char *)v->Data();
  5390. char *found;
  5391. if ((1>n)||(n>(int)strlen(where)))
  5392. {
  5393. Werror("start position %d out of range",n);
  5394. return TRUE;
  5395. }
  5396. found = strchr(where+n-1,*what);
  5397. if (*(what+1)!='\0')
  5398. {
  5399. while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
  5400. {
  5401. found=strchr(found+1,*what);
  5402. }
  5403. }
  5404. if (found != NULL)
  5405. {
  5406. res->data=(char *)((found-where)+1);
  5407. }
  5408. return FALSE;
  5409. }
  5410. static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
  5411. {
  5412. if ((int)(long)w->Data()==0)
  5413. res->data=(char *)walkProc(u,v);
  5414. else
  5415. res->data=(char *)fractalWalkProc(u,v);
  5416. setFlag( res, FLAG_STD );
  5417. return FALSE;
  5418. }
  5419. static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
  5420. {
  5421. intvec *wdegree=(intvec*)w->Data();
  5422. if (wdegree->length()!=pVariables)
  5423. {
  5424. Werror("weight vector must have size %d, not %d",
  5425. pVariables,wdegree->length());
  5426. return TRUE;
  5427. }
  5428. #ifdef HAVE_RINGS
  5429. if (rField_is_Ring_Z(currRing))
  5430. {
  5431. ring origR = currRing;
  5432. ring tempR = rCopy(origR);
  5433. tempR->ringtype = 0; tempR->ch = 0;
  5434. rComplete(tempR);
  5435. ideal uid = (ideal)u->Data();
  5436. rChangeCurrRing(tempR);
  5437. ideal uu = idrCopyR(uid, origR, currRing);
  5438. sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
  5439. uuAsLeftv.rtyp = IDEAL_CMD;
  5440. uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
  5441. if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
  5442. assumeStdFlag(&uuAsLeftv);
  5443. Print("// NOTE: computation of Hilbert series etc. is being\n");
  5444. Print("// performed for generic fibre, that is, over Q\n");
  5445. intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
  5446. intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
  5447. int returnWithTrue = 1;
  5448. switch((int)(long)v->Data())
  5449. {
  5450. case 1:
  5451. res->data=(void *)iv;
  5452. returnWithTrue = 0;
  5453. case 2:
  5454. res->data=(void *)hSecondSeries(iv);
  5455. delete iv;
  5456. returnWithTrue = 0;
  5457. }
  5458. if (returnWithTrue)
  5459. {
  5460. WerrorS(feNotImplemented);
  5461. delete iv;
  5462. }
  5463. idDelete(&uu);
  5464. rChangeCurrRing(origR);
  5465. rDelete(tempR);
  5466. if (returnWithTrue) return TRUE; else return FALSE;
  5467. }
  5468. #endif
  5469. assumeStdFlag(u);
  5470. intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  5471. intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
  5472. switch((int)(long)v->Data())
  5473. {
  5474. case 1:
  5475. res->data=(void *)iv;
  5476. return FALSE;
  5477. case 2:
  5478. res->data=(void *)hSecondSeries(iv);
  5479. delete iv;
  5480. return FALSE;
  5481. }
  5482. WerrorS(feNotImplemented);
  5483. delete iv;
  5484. return TRUE;
  5485. }
  5486. static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
  5487. {
  5488. PrintS("TODO\n");
  5489. int i=pVar((poly)v->Data());
  5490. if (i==0)
  5491. {
  5492. WerrorS("ringvar expected");
  5493. return TRUE;
  5494. }
  5495. poly p=pOne(); pSetExp(p,i,1); pSetm(p);
  5496. int d=pWTotaldegree(p);
  5497. pLmDelete(p);
  5498. if (d==1)
  5499. res->data = (char *)idHomogen((ideal)u->Data(),i);
  5500. else
  5501. WerrorS("variable must have weight 1");
  5502. return (d!=1);
  5503. }
  5504. static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
  5505. {
  5506. PrintS("TODO\n");
  5507. int i=pVar((poly)v->Data());
  5508. if (i==0)
  5509. {
  5510. WerrorS("ringvar expected");
  5511. return TRUE;
  5512. }
  5513. poly p=pOne(); pSetExp(p,i,1); pSetm(p);
  5514. int d=pWTotaldegree(p);
  5515. pLmDelete(p);
  5516. if (d==1)
  5517. res->data = (char *)pHomogen((poly)u->Data(),i);
  5518. else
  5519. WerrorS("variable must have weight 1");
  5520. return (d!=1);
  5521. }
  5522. static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
  5523. {
  5524. intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
  5525. intvec* arg = (intvec*) u->Data();
  5526. int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
  5527. for (i=0; i<n; i++)
  5528. {
  5529. (*im)[i] = (*arg)[i];
  5530. }
  5531. res->data = (char *)im;
  5532. return FALSE;
  5533. }
  5534. static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
  5535. {
  5536. short *iw=iv2array((intvec *)w->Data());
  5537. res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
  5538. omFreeSize((ADDRESS)iw,(pVariables+1)*sizeof(short));
  5539. return FALSE;
  5540. }
  5541. static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
  5542. {
  5543. if (!pIsUnit((poly)v->Data()))
  5544. {
  5545. WerrorS("2nd argument must be a unit");
  5546. return TRUE;
  5547. }
  5548. res->data = (char *)pSeries((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD());
  5549. return FALSE;
  5550. }
  5551. static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
  5552. {
  5553. res->data = (char *)idJetW((ideal)u->Data(),(int)(long)v->Data(),
  5554. (intvec *)w->Data());
  5555. return FALSE;
  5556. }
  5557. static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
  5558. {
  5559. if (!mpIsDiagUnit((matrix)v->Data()))
  5560. {
  5561. WerrorS("2nd argument must be a diagonal matrix of units");
  5562. return TRUE;
  5563. }
  5564. res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
  5565. (matrix)v->CopyD());
  5566. return FALSE;
  5567. }
  5568. static BOOLEAN currRingIsOverIntegralDomain ()
  5569. {
  5570. /* true for fields and Z, false otherwise */
  5571. if (rField_is_Ring_PtoM()) return FALSE;
  5572. if (rField_is_Ring_2toM()) return FALSE;
  5573. if (rField_is_Ring_ModN()) return FALSE;
  5574. return TRUE;
  5575. }
  5576. static BOOLEAN jjMINOR_M(leftv res, leftv v)
  5577. {
  5578. /* Here's the use pattern for the minor command:
  5579. minor ( matrix_expression m, int_expression minorSize,
  5580. optional ideal_expression IasSB, optional int_expression k,
  5581. optional string_expression algorithm,
  5582. optional int_expression cachedMinors,
  5583. optional int_expression cachedMonomials )
  5584. This method here assumes that there are at least two arguments.
  5585. - If IasSB is present, it must be a std basis. All minors will be
  5586. reduced w.r.t. IasSB.
  5587. - If k is absent, all non-zero minors will be computed.
  5588. If k is present and k > 0, the first k non-zero minors will be
  5589. computed.
  5590. If k is present and k < 0, the first |k| minors (some of which
  5591. may be zero) will be computed.
  5592. If k is present and k = 0, an error is reported.
  5593. - If algorithm is absent, all the following arguments must be absent too.
  5594. In this case, a heuristic picks the best-suited algorithm (among
  5595. Bareiss, Laplace, and Laplace with caching).
  5596. If algorithm is present, it must be one of "Bareiss", "bareiss",
  5597. "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
  5598. "cache" two more arguments may be given, determining how many entries
  5599. the cache may have at most, and how many cached monomials there are at
  5600. most. (Cached monomials are counted over all cached polynomials.)
  5601. If these two additional arguments are not provided, 200 and 100000
  5602. will be used as defaults.
  5603. */
  5604. matrix m;
  5605. leftv u=v->next;
  5606. v->next=NULL;
  5607. int v_typ=v->Typ();
  5608. if (v_typ==MATRIX_CMD)
  5609. {
  5610. m = (const matrix)v->Data();
  5611. }
  5612. else
  5613. {
  5614. if (v_typ==0)
  5615. {
  5616. Werror("`%s` is undefined",v->Fullname());
  5617. return TRUE;
  5618. }
  5619. // try to convert to MATRIX:
  5620. int ii=iiTestConvert(v_typ,MATRIX_CMD);
  5621. BOOLEAN bo;
  5622. sleftv tmp;
  5623. if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
  5624. else bo=TRUE;
  5625. if (bo)
  5626. {
  5627. Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
  5628. return TRUE;
  5629. }
  5630. m=(matrix)tmp.data;
  5631. }
  5632. const int mk = (const int)(long)u->Data();
  5633. bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
  5634. bool noCacheMinors = true; bool noCacheMonomials = true;
  5635. ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
  5636. /* here come the different cases of correct argument sets */
  5637. if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
  5638. {
  5639. IasSB = (ideal)u->next->Data();
  5640. noIdeal = false;
  5641. if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
  5642. {
  5643. k = (int)(long)u->next->next->Data();
  5644. noK = false;
  5645. assume(k != 0);
  5646. if ((u->next->next->next != NULL) &&
  5647. (u->next->next->next->Typ() == STRING_CMD))
  5648. {
  5649. algorithm = (char*)u->next->next->next->Data();
  5650. noAlgorithm = false;
  5651. if ((u->next->next->next->next != NULL) &&
  5652. (u->next->next->next->next->Typ() == INT_CMD))
  5653. {
  5654. cacheMinors = (int)(long)u->next->next->next->next->Data();
  5655. noCacheMinors = false;
  5656. if ((u->next->next->next->next->next != NULL) &&
  5657. (u->next->next->next->next->next->Typ() == INT_CMD))
  5658. {
  5659. cacheMonomials =
  5660. (int)(long)u->next->next->next->next->next->Data();
  5661. noCacheMonomials = false;
  5662. }
  5663. }
  5664. }
  5665. }
  5666. }
  5667. else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
  5668. {
  5669. k = (int)(long)u->next->Data();
  5670. noK = false;
  5671. assume(k != 0);
  5672. if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
  5673. {
  5674. algorithm = (char*)u->next->next->Data();
  5675. noAlgorithm = false;
  5676. if ((u->next->next->next != NULL) &&
  5677. (u->next->next->next->Typ() == INT_CMD))
  5678. {
  5679. cacheMinors = (int)(long)u->next->next->next->Data();
  5680. noCacheMinors = false;
  5681. if ((u->next->next->next->next != NULL) &&
  5682. (u->next->next->next->next->Typ() == INT_CMD))
  5683. {
  5684. cacheMonomials = (int)(long)u->next->next->next->next->Data();
  5685. noCacheMonomials = false;
  5686. }
  5687. }
  5688. }
  5689. }
  5690. else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
  5691. {
  5692. algorithm = (char*)u->next->Data();
  5693. noAlgorithm = false;
  5694. if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
  5695. {
  5696. cacheMinors = (int)(long)u->next->next->Data();
  5697. noCacheMinors = false;
  5698. if ((u->next->next->next != NULL) &&
  5699. (u->next->next->next->Typ() == INT_CMD))
  5700. {
  5701. cacheMonomials = (int)(long)u->next->next->next->Data();
  5702. noCacheMonomials = false;
  5703. }
  5704. }
  5705. }
  5706. /* upper case conversion for the algorithm if present */
  5707. if (!noAlgorithm)
  5708. {
  5709. if (strcmp(algorithm, "bareiss") == 0)
  5710. algorithm = (char*)"Bareiss";
  5711. if (strcmp(algorithm, "laplace") == 0)
  5712. algorithm = (char*)"Laplace";
  5713. if (strcmp(algorithm, "cache") == 0)
  5714. algorithm = (char*)"Cache";
  5715. }
  5716. v->next=u;
  5717. /* here come some tests */
  5718. if (!noIdeal)
  5719. {
  5720. assumeStdFlag(u->next);
  5721. }
  5722. if ((!noK) && (k == 0))
  5723. {
  5724. WerrorS("Provided number of minors to be computed is zero.");
  5725. return TRUE;
  5726. }
  5727. if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
  5728. && (strcmp(algorithm, "Laplace") != 0)
  5729. && (strcmp(algorithm, "Cache") != 0))
  5730. {
  5731. WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
  5732. return TRUE;
  5733. }
  5734. if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
  5735. && (!currRingIsOverIntegralDomain()))
  5736. {
  5737. Werror("Bareiss algorithm not defined over coefficient rings %s",
  5738. "with zero divisors.");
  5739. return TRUE;
  5740. }
  5741. if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
  5742. {
  5743. Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
  5744. m->rows(), m->cols());
  5745. return TRUE;
  5746. }
  5747. if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
  5748. && (noCacheMinors || noCacheMonomials))
  5749. {
  5750. cacheMinors = 200;
  5751. cacheMonomials = 100000;
  5752. }
  5753. /* here come the actual procedure calls */
  5754. if (noAlgorithm)
  5755. res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
  5756. (noIdeal ? 0 : IasSB), false);
  5757. else if (strcmp(algorithm, "Cache") == 0)
  5758. res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
  5759. (noIdeal ? 0 : IasSB), 3, cacheMinors,
  5760. cacheMonomials, false);
  5761. else
  5762. res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
  5763. (noIdeal ? 0 : IasSB), false);
  5764. if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
  5765. res->rtyp = IDEAL_CMD;
  5766. return FALSE;
  5767. }
  5768. static BOOLEAN jjNEWSTRUCT3(leftv res, leftv u, leftv v, leftv w)
  5769. {
  5770. // u: the name of the new type
  5771. // v: the parent type
  5772. // w: the elements
  5773. newstruct_desc d=newstructChildFromString((const char *)v->Data(),
  5774. (const char *)w->Data());
  5775. if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
  5776. return d==NULL;
  5777. }
  5778. static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
  5779. {
  5780. // handles preimage(r,phi,i) and kernel(r,phi)
  5781. idhdl h;
  5782. ring rr;
  5783. map mapping;
  5784. BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
  5785. if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
  5786. {
  5787. WerrorS("2nd/3rd arguments must have names");
  5788. return TRUE;
  5789. }
  5790. rr=(ring)u->Data();
  5791. const char *ring_name=u->Name();
  5792. if ((h=rr->idroot->get(v->name,myynest))!=NULL)
  5793. {
  5794. if (h->typ==MAP_CMD)
  5795. {
  5796. mapping=IDMAP(h);
  5797. idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
  5798. if ((preim_ring==NULL)
  5799. || (IDRING(preim_ring)!=currRing))
  5800. {
  5801. Werror("preimage ring `%s` is not the basering",mapping->preimage);
  5802. return TRUE;
  5803. }
  5804. }
  5805. else if (h->typ==IDEAL_CMD)
  5806. {
  5807. mapping=IDMAP(h);
  5808. }
  5809. else
  5810. {
  5811. Werror("`%s` is no map nor ideal",IDID(h));
  5812. return TRUE;
  5813. }
  5814. }
  5815. else
  5816. {
  5817. Werror("`%s` is not defined in `%s`",v->name,ring_name);
  5818. return TRUE;
  5819. }
  5820. ideal image;
  5821. if (kernel_cmd) image=idInit(1,1);
  5822. else
  5823. {
  5824. if ((h=rr->idroot->get(w->name,myynest))!=NULL)
  5825. {
  5826. if (h->typ==IDEAL_CMD)
  5827. {
  5828. image=IDIDEAL(h);
  5829. }
  5830. else
  5831. {
  5832. Werror("`%s` is no ideal",IDID(h));
  5833. return TRUE;
  5834. }
  5835. }
  5836. else
  5837. {
  5838. Werror("`%s` is not defined in `%s`",w->name,ring_name);
  5839. return TRUE;
  5840. }
  5841. }
  5842. if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
  5843. || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
  5844. {
  5845. WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
  5846. }
  5847. res->data=(char *)maGetPreimage(rr,mapping,image);
  5848. if (kernel_cmd) idDelete(&image);
  5849. return (res->data==NULL/* is of type ideal, should not be NULL*/);
  5850. }
  5851. static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
  5852. {
  5853. int di, k;
  5854. int i=(int)(long)u->Data();
  5855. int r=(int)(long)v->Data();
  5856. int c=(int)(long)w->Data();
  5857. if ((r<=0) || (c<=0)) return TRUE;
  5858. intvec *iv = new intvec(r, c, 0);
  5859. if (iv->rows()==0)
  5860. {
  5861. delete iv;
  5862. return TRUE;
  5863. }
  5864. if (i!=0)
  5865. {
  5866. if (i<0) i = -i;
  5867. di = 2 * i + 1;
  5868. for (k=0; k<iv->length(); k++)
  5869. {
  5870. (*iv)[k] = ((siRand() % di) - i);
  5871. }
  5872. }
  5873. res->data = (char *)iv;
  5874. return FALSE;
  5875. }
  5876. static BOOLEAN jjSUBST_Test(leftv v,leftv w,
  5877. int &ringvar, poly &monomexpr)
  5878. {
  5879. monomexpr=(poly)w->Data();
  5880. poly p=(poly)v->Data();
  5881. #if 0
  5882. if (pLength(monomexpr)>1)
  5883. {
  5884. Werror("`%s` substitutes a ringvar only by a term",
  5885. Tok2Cmdname(SUBST_CMD));
  5886. return TRUE;
  5887. }
  5888. #endif
  5889. if (!(ringvar=pVar(p)))
  5890. {
  5891. if (rField_is_Extension(currRing))
  5892. {
  5893. assume(currRing->algring!=NULL);
  5894. lnumber n=(lnumber)pGetCoeff(p);
  5895. ringvar=-p_Var(n->z,currRing->algring);
  5896. }
  5897. if(ringvar==0)
  5898. {
  5899. WerrorS("ringvar/par expected");
  5900. return TRUE;
  5901. }
  5902. }
  5903. return FALSE;
  5904. }
  5905. static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
  5906. {
  5907. int ringvar;
  5908. poly monomexpr;
  5909. BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
  5910. if (nok) return TRUE;
  5911. poly p=(poly)u->Data();
  5912. if (ringvar>0)
  5913. {
  5914. if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
  5915. ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
  5916. {
  5917. Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
  5918. //return TRUE;
  5919. }
  5920. if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
  5921. res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
  5922. else
  5923. res->data= pSubstPoly(p,ringvar,monomexpr);
  5924. }
  5925. else
  5926. {
  5927. res->data=pSubstPar(p,-ringvar,monomexpr);
  5928. }
  5929. return FALSE;
  5930. }
  5931. static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
  5932. {
  5933. int ringvar;
  5934. poly monomexpr;
  5935. BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
  5936. if (nok) return TRUE;
  5937. if (ringvar>0)
  5938. {
  5939. if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
  5940. res->data = idSubst((ideal)u->CopyD(res->rtyp),ringvar,monomexpr);
  5941. else
  5942. res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
  5943. }
  5944. else
  5945. {
  5946. res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
  5947. }
  5948. return FALSE;
  5949. }
  5950. // we do not want to have jjSUBST_Id_X inlined:
  5951. static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
  5952. int input_type);
  5953. static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
  5954. {
  5955. return jjSUBST_Id_X(res,u,v,w,INT_CMD);
  5956. }
  5957. static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
  5958. {
  5959. return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
  5960. }
  5961. static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
  5962. {
  5963. sleftv tmp;
  5964. memset(&tmp,0,sizeof(tmp));
  5965. // do not check the result, conversion from int/number to poly works always
  5966. iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
  5967. BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
  5968. tmp.CleanUp();
  5969. return b;
  5970. }
  5971. static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
  5972. {
  5973. matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
  5974. ideal I=(ideal)u->CopyD(IDEAL_CMD);
  5975. int i=si_min(IDELEMS(I),(int)(long)v->Data()*(int)(long)w->Data());
  5976. //for(i=i-1;i>=0;i--)
  5977. //{
  5978. // m->m[i]=I->m[i];
  5979. // I->m[i]=NULL;
  5980. //}
  5981. memcpy(m->m,I->m,i*sizeof(poly));
  5982. memset(I->m,0,i*sizeof(poly));
  5983. idDelete(&I);
  5984. res->data = (char *)m;
  5985. return FALSE;
  5986. }
  5987. static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
  5988. {
  5989. res->data = (char *)idModule2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
  5990. (int)(long)v->Data(),(int)(long)w->Data());
  5991. return FALSE;
  5992. }
  5993. static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
  5994. {
  5995. matrix m=mpNew((int)(long)v->Data(),(int)(long)w->Data());
  5996. matrix I=(matrix)u->CopyD(MATRIX_CMD);
  5997. int r=si_min(MATROWS(I),(int)(long)v->Data());
  5998. int c=si_min(MATCOLS(I),(int)(long)w->Data());
  5999. int i,j;
  6000. for(i=r;i>0;i--)
  6001. {
  6002. for(j=c;j>0;j--)
  6003. {
  6004. MATELEM(m,i,j)=MATELEM(I,i,j);
  6005. MATELEM(I,i,j)=NULL;
  6006. }
  6007. }
  6008. idDelete((ideal *)&I);
  6009. res->data = (char *)m;
  6010. return FALSE;
  6011. }
  6012. static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
  6013. {
  6014. if (w->rtyp!=IDHDL) return TRUE;
  6015. BITSET save_test=test;
  6016. int ul= IDELEMS((ideal)u->Data());
  6017. int vl= IDELEMS((ideal)v->Data());
  6018. ideal m
  6019. = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
  6020. FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
  6021. res->data = (char *)idModule2formatedMatrix(m,ul,vl);
  6022. test=save_test;
  6023. return FALSE;
  6024. }
  6025. static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
  6026. {
  6027. if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
  6028. if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
  6029. idhdl hv=(idhdl)v->data;
  6030. idhdl hw=(idhdl)w->data;
  6031. // CopyD for IDEAL_CMD and MODUL_CMD are identical:
  6032. res->data = (char *)idLiftStd((ideal)u->Data(),
  6033. &(hv->data.umatrix),testHomog,
  6034. &(hw->data.uideal));
  6035. setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
  6036. return FALSE;
  6037. }
  6038. static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
  6039. {
  6040. assumeStdFlag(v);
  6041. if (!idIsZeroDim((ideal)v->Data()))
  6042. {
  6043. Werror("`%s` must be 0-dimensional",v->Name());
  6044. return TRUE;
  6045. }
  6046. res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
  6047. (poly)w->CopyD());
  6048. return FALSE;
  6049. }
  6050. static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
  6051. {
  6052. assumeStdFlag(v);
  6053. if (!idIsZeroDim((ideal)v->Data()))
  6054. {
  6055. Werror("`%s` must be 0-dimensional",v->Name());
  6056. return TRUE;
  6057. }
  6058. res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
  6059. (matrix)w->CopyD());
  6060. return FALSE;
  6061. }
  6062. static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
  6063. {
  6064. assumeStdFlag(v);
  6065. res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
  6066. 0,(int)(long)w->Data());
  6067. return FALSE;
  6068. }
  6069. static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
  6070. {
  6071. assumeStdFlag(v);
  6072. res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
  6073. 0,(int)(long)w->Data());
  6074. return FALSE;
  6075. }
  6076. #ifdef OLD_RES
  6077. static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
  6078. {
  6079. int maxl=(int)v->Data();
  6080. ideal u_id=(ideal)u->Data();
  6081. int l=0;
  6082. resolvente r;
  6083. intvec **weights=NULL;
  6084. int wmaxl=maxl;
  6085. maxl--;
  6086. if ((maxl==-1) && (iiOp!=MRES_CMD))
  6087. maxl = pVariables-1;
  6088. if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
  6089. {
  6090. intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
  6091. if (iv!=NULL)
  6092. {
  6093. l=1;
  6094. if (!idTestHomModule(u_id,currQuotient,iv))
  6095. {
  6096. WarnS("wrong weights");
  6097. iv=NULL;
  6098. }
  6099. else
  6100. {
  6101. weights = (intvec**)omAlloc0Bin(char_ptr_bin);
  6102. weights[0] = ivCopy(iv);
  6103. }
  6104. }
  6105. r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
  6106. }
  6107. else
  6108. r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
  6109. if (r==NULL) return TRUE;
  6110. int t3=u->Typ();
  6111. iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
  6112. return FALSE;
  6113. }
  6114. #endif
  6115. static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
  6116. {
  6117. res->data=(void *)rInit(u,v,w);
  6118. return (res->data==NULL);
  6119. }
  6120. static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
  6121. {
  6122. int yes;
  6123. jjSTATUS2(res, u, v);
  6124. yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
  6125. omFree((ADDRESS) res->data);
  6126. res->data = (void *)(long)yes;
  6127. return FALSE;
  6128. }
  6129. static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
  6130. {
  6131. intvec *vw=(intvec *)w->Data(); // weights of vars
  6132. if (vw->length()!=currRing->N)
  6133. {
  6134. Werror("%d weights for %d variables",vw->length(),currRing->N);
  6135. return TRUE;
  6136. }
  6137. ideal result;
  6138. intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  6139. tHomog hom=testHomog;
  6140. ideal u_id=(ideal)(u->Data());
  6141. if (ww!=NULL)
  6142. {
  6143. if (!idTestHomModule(u_id,currQuotient,ww))
  6144. {
  6145. WarnS("wrong weights");
  6146. ww=NULL;
  6147. }
  6148. else
  6149. {
  6150. ww=ivCopy(ww);
  6151. hom=isHomog;
  6152. }
  6153. }
  6154. result=kStd(u_id,
  6155. currQuotient,
  6156. hom,
  6157. &ww, // module weights
  6158. (intvec *)v->Data(), // hilbert series
  6159. 0,0, // syzComp, newIdeal
  6160. vw); // weights of vars
  6161. idSkipZeroes(result);
  6162. res->data = (char *)result;
  6163. setFlag(res,FLAG_STD);
  6164. if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
  6165. return FALSE;
  6166. }
  6167. /*=================== operations with many arg.: static proc =================*/
  6168. /* must be ordered: first operations for chars (infix ops),
  6169. * then alphabetically */
  6170. static BOOLEAN jjBREAK0(leftv res, leftv v)
  6171. {
  6172. #ifdef HAVE_SDB
  6173. sdb_show_bp();
  6174. #endif
  6175. return FALSE;
  6176. }
  6177. static BOOLEAN jjBREAK1(leftv res, leftv v)
  6178. {
  6179. #ifdef HAVE_SDB
  6180. if(v->Typ()==PROC_CMD)
  6181. {
  6182. int lineno=0;
  6183. if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
  6184. {
  6185. lineno=(int)(long)v->next->Data();
  6186. }
  6187. return sdb_set_breakpoint(v->Name(),lineno);
  6188. }
  6189. return TRUE;
  6190. #else
  6191. return FALSE;
  6192. #endif
  6193. }
  6194. static BOOLEAN jjCALL1ARG(leftv res, leftv v)
  6195. {
  6196. return iiExprArith1(res,v,iiOp);
  6197. }
  6198. static BOOLEAN jjCALL2ARG(leftv res, leftv u)
  6199. {
  6200. leftv v=u->next;
  6201. u->next=NULL;
  6202. BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
  6203. u->next=v;
  6204. return b;
  6205. }
  6206. static BOOLEAN jjCALL3ARG(leftv res, leftv u)
  6207. {
  6208. leftv v = u->next;
  6209. leftv w = v->next;
  6210. u->next = NULL;
  6211. v->next = NULL;
  6212. BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
  6213. u->next = v;
  6214. v->next = w;
  6215. return b;
  6216. }
  6217. static BOOLEAN jjCOEF_M(leftv res, leftv v)
  6218. {
  6219. if((v->Typ() != VECTOR_CMD)
  6220. || (v->next->Typ() != POLY_CMD)
  6221. || (v->next->next->Typ() != MATRIX_CMD)
  6222. || (v->next->next->next->Typ() != MATRIX_CMD))
  6223. return TRUE;
  6224. if (v->next->next->rtyp!=IDHDL) return TRUE;
  6225. idhdl c=(idhdl)v->next->next->data;
  6226. if (v->next->next->next->rtyp!=IDHDL) return TRUE;
  6227. idhdl m=(idhdl)v->next->next->next->data;
  6228. idDelete((ideal *)&(c->data.uideal));
  6229. idDelete((ideal *)&(m->data.uideal));
  6230. mpCoef2((poly)v->Data(),(poly)v->next->Data(),
  6231. (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix));
  6232. return FALSE;
  6233. }
  6234. static BOOLEAN jjDIVISION4(leftv res, leftv v)
  6235. { // may have 3 or 4 arguments
  6236. leftv v1=v;
  6237. leftv v2=v1->next;
  6238. leftv v3=v2->next;
  6239. leftv v4=v3->next;
  6240. assumeStdFlag(v2);
  6241. int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
  6242. int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
  6243. if((i1==0)||(i2==0)
  6244. ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
  6245. {
  6246. WarnS("<module>,<module>,<int>[,<intvec>] expected!");
  6247. return TRUE;
  6248. }
  6249. sleftv w1,w2;
  6250. iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
  6251. iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
  6252. ideal P=(ideal)w1.Data();
  6253. ideal Q=(ideal)w2.Data();
  6254. int n=(int)(long)v3->Data();
  6255. short *w=NULL;
  6256. if(v4!=NULL)
  6257. {
  6258. w=iv2array((intvec *)v4->Data());
  6259. short *w0=w+1;
  6260. int i=pVariables;
  6261. while(i>0&&*w0>0)
  6262. {
  6263. w0++;
  6264. i--;
  6265. }
  6266. if(i>0)
  6267. WarnS("not all weights are positive!");
  6268. }
  6269. matrix T;
  6270. ideal R;
  6271. idLiftW(P,Q,n,T,R,w);
  6272. w1.CleanUp();
  6273. w2.CleanUp();
  6274. if(w!=NULL)
  6275. omFree(w);
  6276. lists L=(lists) omAllocBin(slists_bin);
  6277. L->Init(2);
  6278. L->m[1].rtyp=v1->Typ();
  6279. if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
  6280. {
  6281. if(v1->Typ()==POLY_CMD)
  6282. pShift(&R->m[0],-1);
  6283. L->m[1].data=(void *)R->m[0];
  6284. R->m[0]=NULL;
  6285. idDelete(&R);
  6286. }
  6287. else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
  6288. L->m[1].data=(void *)idModule2Matrix(R);
  6289. else
  6290. {
  6291. L->m[1].rtyp=MODUL_CMD;
  6292. L->m[1].data=(void *)R;
  6293. }
  6294. L->m[0].rtyp=MATRIX_CMD;
  6295. L->m[0].data=(char *)T;
  6296. res->data=L;
  6297. res->rtyp=LIST_CMD;
  6298. return FALSE;
  6299. }
  6300. //static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
  6301. //{
  6302. // int l=u->listLength();
  6303. // if (l<2) return TRUE;
  6304. // BOOLEAN b;
  6305. // leftv v=u->next;
  6306. // leftv zz=v;
  6307. // leftv z=zz;
  6308. // u->next=NULL;
  6309. // do
  6310. // {
  6311. // leftv z=z->next;
  6312. // b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
  6313. // if (b) break;
  6314. // } while (z!=NULL);
  6315. // u->next=zz;
  6316. // return b;
  6317. //}
  6318. static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
  6319. {
  6320. int s=1;
  6321. leftv h=v;
  6322. if (h!=NULL) s=exprlist_length(h);
  6323. ideal id=idInit(s,1);
  6324. int rank=1;
  6325. int i=0;
  6326. poly p;
  6327. while (h!=NULL)
  6328. {
  6329. switch(h->Typ())
  6330. {
  6331. case POLY_CMD:
  6332. {
  6333. p=(poly)h->CopyD(POLY_CMD);
  6334. break;
  6335. }
  6336. case INT_CMD:
  6337. {
  6338. number n=nInit((int)(long)h->Data());
  6339. if (!nIsZero(n))
  6340. {
  6341. p=pNSet(n);
  6342. }
  6343. else
  6344. {
  6345. p=NULL;
  6346. nDelete(&n);
  6347. }
  6348. break;
  6349. }
  6350. case BIGINT_CMD:
  6351. {
  6352. number b=(number)h->Data();
  6353. number n=nInit_bigint(b);
  6354. if (!nIsZero(n))
  6355. {
  6356. p=pNSet(n);
  6357. }
  6358. else
  6359. {
  6360. p=NULL;
  6361. nDelete(&n);
  6362. }
  6363. break;
  6364. }
  6365. case NUMBER_CMD:
  6366. {
  6367. number n=(number)h->CopyD(NUMBER_CMD);
  6368. if (!nIsZero(n))
  6369. {
  6370. p=pNSet(n);
  6371. }
  6372. else
  6373. {
  6374. p=NULL;
  6375. nDelete(&n);
  6376. }
  6377. break;
  6378. }
  6379. case VECTOR_CMD:
  6380. {
  6381. p=(poly)h->CopyD(VECTOR_CMD);
  6382. if (iiOp!=MODUL_CMD)
  6383. {
  6384. idDelete(&id);
  6385. pDelete(&p);
  6386. return TRUE;
  6387. }
  6388. rank=si_max(rank,(int)pMaxComp(p));
  6389. break;
  6390. }
  6391. default:
  6392. {
  6393. idDelete(&id);
  6394. return TRUE;
  6395. }
  6396. }
  6397. if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
  6398. {
  6399. pSetCompP(p,1);
  6400. }
  6401. id->m[i]=p;
  6402. i++;
  6403. h=h->next;
  6404. }
  6405. id->rank=rank;
  6406. res->data=(char *)id;
  6407. return FALSE;
  6408. }
  6409. static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
  6410. {
  6411. leftv h=v;
  6412. int l=v->listLength();
  6413. resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
  6414. BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
  6415. int t=0;
  6416. // try to convert to IDEAL_CMD
  6417. while (h!=NULL)
  6418. {
  6419. if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
  6420. {
  6421. t=IDEAL_CMD;
  6422. }
  6423. else break;
  6424. h=h->next;
  6425. }
  6426. // if failure, try MODUL_CMD
  6427. if (t==0)
  6428. {
  6429. h=v;
  6430. while (h!=NULL)
  6431. {
  6432. if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
  6433. {
  6434. t=MODUL_CMD;
  6435. }
  6436. else break;
  6437. h=h->next;
  6438. }
  6439. }
  6440. // check for success in converting
  6441. if (t==0)
  6442. {
  6443. WerrorS("cannot convert to ideal or module");
  6444. return TRUE;
  6445. }
  6446. // call idMultSect
  6447. h=v;
  6448. int i=0;
  6449. sleftv tmp;
  6450. while (h!=NULL)
  6451. {
  6452. if (h->Typ()==t)
  6453. {
  6454. r[i]=(ideal)h->Data(); /*no copy*/
  6455. h=h->next;
  6456. }
  6457. else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
  6458. {
  6459. omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
  6460. omFreeSize((ADDRESS)r,l*sizeof(ideal));
  6461. Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
  6462. return TRUE;
  6463. }
  6464. else
  6465. {
  6466. r[i]=(ideal)tmp.Data(); /*now it's a copy*/
  6467. copied[i]=TRUE;
  6468. h=tmp.next;
  6469. }
  6470. i++;
  6471. }
  6472. res->rtyp=t;
  6473. res->data=(char *)idMultSect(r,i);
  6474. while(i>0)
  6475. {
  6476. i--;
  6477. if (copied[i]) idDelete(&(r[i]));
  6478. }
  6479. omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
  6480. omFreeSize((ADDRESS)r,l*sizeof(ideal));
  6481. return FALSE;
  6482. }
  6483. static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
  6484. {
  6485. /* computation of the inverse of a quadratic matrix A
  6486. using the L-U-decomposition of A;
  6487. There are two valid parametrisations:
  6488. 1) exactly one argument which is just the matrix A,
  6489. 2) exactly three arguments P, L, U which already
  6490. realise the L-U-decomposition of A, that is,
  6491. P * A = L * U, and P, L, and U satisfy the
  6492. properties decribed in method 'jjLU_DECOMP';
  6493. see there;
  6494. If A is invertible, the list [1, A^(-1)] is returned,
  6495. otherwise the list [0] is returned. Thus, the user may
  6496. inspect the first entry of the returned list to see
  6497. whether A is invertible. */
  6498. matrix iMat; int invertible;
  6499. if (v->next == NULL)
  6500. {
  6501. if (v->Typ() != MATRIX_CMD)
  6502. {
  6503. Werror("expected either one or three matrices");
  6504. return TRUE;
  6505. }
  6506. else
  6507. {
  6508. matrix aMat = (matrix)v->Data();
  6509. int rr = aMat->rows();
  6510. int cc = aMat->cols();
  6511. if (rr != cc)
  6512. {
  6513. Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
  6514. return TRUE;
  6515. }
  6516. invertible = luInverse(aMat, iMat);
  6517. }
  6518. }
  6519. else if ((v->Typ() == MATRIX_CMD) &&
  6520. (v->next->Typ() == MATRIX_CMD) &&
  6521. (v->next->next != NULL) &&
  6522. (v->next->next->Typ() == MATRIX_CMD) &&
  6523. (v->next->next->next == NULL))
  6524. {
  6525. matrix pMat = (matrix)v->Data();
  6526. matrix lMat = (matrix)v->next->Data();
  6527. matrix uMat = (matrix)v->next->next->Data();
  6528. int rr = uMat->rows();
  6529. int cc = uMat->cols();
  6530. if (rr != cc)
  6531. {
  6532. Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
  6533. rr, cc);
  6534. return TRUE;
  6535. }
  6536. invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
  6537. }
  6538. else
  6539. {
  6540. Werror("expected either one or three matrices");
  6541. return TRUE;
  6542. }
  6543. /* build the return structure; a list with either one or two entries */
  6544. lists ll = (lists)omAllocBin(slists_bin);
  6545. if (invertible)
  6546. {
  6547. ll->Init(2);
  6548. ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)invertible;
  6549. ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
  6550. }
  6551. else
  6552. {
  6553. ll->Init(1);
  6554. ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)invertible;
  6555. }
  6556. res->data=(char*)ll;
  6557. return FALSE;
  6558. }
  6559. static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
  6560. {
  6561. /* for solving a linear equation system A * x = b, via the
  6562. given LU-decomposition of the matrix A;
  6563. There is one valid parametrisation:
  6564. 1) exactly four arguments P, L, U, b;
  6565. P, L, and U realise the L-U-decomposition of A, that is,
  6566. P * A = L * U, and P, L, and U satisfy the
  6567. properties decribed in method 'jjLU_DECOMP';
  6568. see there;
  6569. b is the right-hand side vector of the equation system;
  6570. The method will return a list of either 1 entry or three entries:
  6571. 1) [0] if there is no solution to the system;
  6572. 2) [1, x, H] if there is at least one solution;
  6573. x is any solution of the given linear system,
  6574. H is the matrix with column vectors spanning the homogeneous
  6575. solution space.
  6576. The method produces an error if matrix and vector sizes do not fit. */
  6577. if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
  6578. (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
  6579. (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
  6580. (v->next->next->next == NULL) ||
  6581. (v->next->next->next->Typ() != MATRIX_CMD) ||
  6582. (v->next->next->next->next != NULL))
  6583. {
  6584. WerrorS("expected exactly three matrices and one vector as input");
  6585. return TRUE;
  6586. }
  6587. matrix pMat = (matrix)v->Data();
  6588. matrix lMat = (matrix)v->next->Data();
  6589. matrix uMat = (matrix)v->next->next->Data();
  6590. matrix bVec = (matrix)v->next->next->next->Data();
  6591. matrix xVec; int solvable; matrix homogSolSpace;
  6592. if (pMat->rows() != pMat->cols())
  6593. {
  6594. Werror("first matrix (%d x %d) is not quadratic",
  6595. pMat->rows(), pMat->cols());
  6596. return TRUE;
  6597. }
  6598. if (lMat->rows() != lMat->cols())
  6599. {
  6600. Werror("second matrix (%d x %d) is not quadratic",
  6601. lMat->rows(), lMat->cols());
  6602. return TRUE;
  6603. }
  6604. if (lMat->rows() != uMat->rows())
  6605. {
  6606. Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
  6607. lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
  6608. return TRUE;
  6609. }
  6610. if (uMat->rows() != bVec->rows())
  6611. {
  6612. Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
  6613. uMat->rows(), uMat->cols(), bVec->rows());
  6614. return TRUE;
  6615. }
  6616. solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
  6617. /* build the return structure; a list with either one or three entries */
  6618. lists ll = (lists)omAllocBin(slists_bin);
  6619. if (solvable)
  6620. {
  6621. ll->Init(3);
  6622. ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)solvable;
  6623. ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
  6624. ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
  6625. }
  6626. else
  6627. {
  6628. ll->Init(1);
  6629. ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)solvable;
  6630. }
  6631. res->data=(char*)ll;
  6632. return FALSE;
  6633. }
  6634. static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
  6635. {
  6636. int i=0;
  6637. leftv h=v;
  6638. if (h!=NULL) i=exprlist_length(h);
  6639. intvec *iv=new intvec(i);
  6640. i=0;
  6641. while (h!=NULL)
  6642. {
  6643. if(h->Typ()==INT_CMD)
  6644. {
  6645. (*iv)[i]=(int)(long)h->Data();
  6646. }
  6647. else
  6648. {
  6649. delete iv;
  6650. return TRUE;
  6651. }
  6652. i++;
  6653. h=h->next;
  6654. }
  6655. res->data=(char *)iv;
  6656. return FALSE;
  6657. }
  6658. static BOOLEAN jjJET4(leftv res, leftv u)
  6659. {
  6660. leftv u1=u;
  6661. leftv u2=u1->next;
  6662. leftv u3=u2->next;
  6663. leftv u4=u3->next;
  6664. if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
  6665. &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
  6666. {
  6667. if(!pIsUnit((poly)u2->Data()))
  6668. {
  6669. WerrorS("2nd argument must be a unit");
  6670. return TRUE;
  6671. }
  6672. res->rtyp=u1->Typ();
  6673. res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
  6674. pCopy((poly)u2->Data()),(intvec*)u4->Data());
  6675. return FALSE;
  6676. }
  6677. else
  6678. if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
  6679. &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
  6680. {
  6681. if(!mpIsDiagUnit((matrix)u2->Data()))
  6682. {
  6683. WerrorS("2nd argument must be a diagonal matrix of units");
  6684. return TRUE;
  6685. }
  6686. res->rtyp=u1->Typ();
  6687. res->data=(char*)idSeries((int)(long)u3->Data(),idCopy((ideal)u1->Data()),
  6688. mpCopy((matrix)u2->Data()),(intvec*)u4->Data());
  6689. return FALSE;
  6690. }
  6691. else
  6692. {
  6693. Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
  6694. Tok2Cmdname(iiOp));
  6695. return TRUE;
  6696. }
  6697. }
  6698. static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
  6699. {
  6700. if ((yyInRingConstruction)
  6701. && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
  6702. {
  6703. memcpy(res,u,sizeof(sleftv));
  6704. memset(u,0,sizeof(sleftv));
  6705. return FALSE;
  6706. }
  6707. leftv v=u->next;
  6708. BOOLEAN b;
  6709. if(v==NULL)
  6710. b=iiExprArith1(res,u,iiOp);
  6711. else
  6712. {
  6713. u->next=NULL;
  6714. b=iiExprArith2(res,u,iiOp,v);
  6715. u->next=v;
  6716. }
  6717. return b;
  6718. }
  6719. BOOLEAN jjLIST_PL(leftv res, leftv v)
  6720. {
  6721. int sl=0;
  6722. if (v!=NULL) sl = v->listLength();
  6723. lists L;
  6724. if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
  6725. {
  6726. int add_row_shift = 0;
  6727. intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
  6728. if (weights!=NULL) add_row_shift=weights->min_in();
  6729. L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
  6730. }
  6731. else
  6732. {
  6733. L=(lists)omAllocBin(slists_bin);
  6734. leftv h=NULL;
  6735. int i;
  6736. int rt;
  6737. L->Init(sl);
  6738. for (i=0;i<sl;i++)
  6739. {
  6740. if (h!=NULL)
  6741. { /* e.g. not in the first step:
  6742. * h is the pointer to the old sleftv,
  6743. * v is the pointer to the next sleftv
  6744. * (in this moment) */
  6745. h->next=v;
  6746. }
  6747. h=v;
  6748. v=v->next;
  6749. h->next=NULL;
  6750. rt=h->Typ();
  6751. if (rt==0)
  6752. {
  6753. L->Clean();
  6754. Werror("`%s` is undefined",h->Fullname());
  6755. return TRUE;
  6756. }
  6757. if ((rt==RING_CMD)||(rt==QRING_CMD))
  6758. {
  6759. L->m[i].rtyp=rt; L->m[i].data=h->Data();
  6760. ((ring)L->m[i].data)->ref++;
  6761. }
  6762. else
  6763. L->m[i].Copy(h);
  6764. }
  6765. }
  6766. res->data=(char *)L;
  6767. return FALSE;
  6768. }
  6769. static BOOLEAN jjNAMES0(leftv res, leftv v)
  6770. {
  6771. res->data=(void *)ipNameList(IDROOT);
  6772. return FALSE;
  6773. }
  6774. static BOOLEAN jjOPTION_PL(leftv res, leftv v)
  6775. {
  6776. if(v==NULL)
  6777. {
  6778. res->data=(char *)showOption();
  6779. return FALSE;
  6780. }
  6781. res->rtyp=NONE;
  6782. return setOption(res,v);
  6783. }
  6784. static BOOLEAN jjREDUCE4(leftv res, leftv u)
  6785. {
  6786. leftv u1=u;
  6787. leftv u2=u1->next;
  6788. leftv u3=u2->next;
  6789. leftv u4=u3->next;
  6790. if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
  6791. {
  6792. int save_d=Kstd1_deg;
  6793. Kstd1_deg=(int)(long)u3->Data();
  6794. kModW=(intvec *)u4->Data();
  6795. BITSET save=verbose;
  6796. verbose|=Sy_bit(V_DEG_STOP);
  6797. u2->next=NULL;
  6798. BOOLEAN r=jjCALL2ARG(res,u);
  6799. kModW=NULL;
  6800. Kstd1_deg=save_d;
  6801. verbose=save;
  6802. u->next->next=u3;
  6803. return r;
  6804. }
  6805. else
  6806. if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
  6807. (u4->Typ()==INT_CMD))
  6808. {
  6809. assumeStdFlag(u3);
  6810. if(!mpIsDiagUnit((matrix)u2->Data()))
  6811. {
  6812. WerrorS("2nd argument must be a diagonal matrix of units");
  6813. return TRUE;
  6814. }
  6815. res->rtyp=IDEAL_CMD;
  6816. res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
  6817. mpCopy((matrix)u2->Data()),(int)(long)u4->Data());
  6818. return FALSE;
  6819. }
  6820. else
  6821. if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
  6822. (u4->Typ()==INT_CMD))
  6823. {
  6824. assumeStdFlag(u3);
  6825. if(!pIsUnit((poly)u2->Data()))
  6826. {
  6827. WerrorS("2nd argument must be a unit");
  6828. return TRUE;
  6829. }
  6830. res->rtyp=POLY_CMD;
  6831. res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
  6832. pCopy((poly)u2->Data()),(int)(long)u4->Data());
  6833. return FALSE;
  6834. }
  6835. else
  6836. {
  6837. Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
  6838. return TRUE;
  6839. }
  6840. }
  6841. static BOOLEAN jjREDUCE5(leftv res, leftv u)
  6842. {
  6843. leftv u1=u;
  6844. leftv u2=u1->next;
  6845. leftv u3=u2->next;
  6846. leftv u4=u3->next;
  6847. leftv u5=u4->next;
  6848. if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
  6849. (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
  6850. {
  6851. assumeStdFlag(u3);
  6852. if(!mpIsDiagUnit((matrix)u2->Data()))
  6853. {
  6854. WerrorS("2nd argument must be a diagonal matrix of units");
  6855. return TRUE;
  6856. }
  6857. res->rtyp=IDEAL_CMD;
  6858. res->data=(char*)redNF(idCopy((ideal)u3->Data()),idCopy((ideal)u1->Data()),
  6859. mpCopy((matrix)u2->Data()),
  6860. (int)(long)u4->Data(),(intvec*)u5->Data());
  6861. return FALSE;
  6862. }
  6863. else
  6864. if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
  6865. (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
  6866. {
  6867. assumeStdFlag(u3);
  6868. if(!pIsUnit((poly)u2->Data()))
  6869. {
  6870. WerrorS("2nd argument must be a unit");
  6871. return TRUE;
  6872. }
  6873. res->rtyp=POLY_CMD;
  6874. res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
  6875. pCopy((poly)u2->Data()),
  6876. (int)(long)u4->Data(),(intvec*)u5->Data());
  6877. return FALSE;
  6878. }
  6879. else
  6880. {
  6881. Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
  6882. Tok2Cmdname(iiOp));
  6883. return TRUE;
  6884. }
  6885. }
  6886. static BOOLEAN jjRESERVED0(leftv res, leftv v)
  6887. {
  6888. int i=1;
  6889. int nCount = (sArithBase.nCmdUsed-1)/3;
  6890. if((3*nCount)<sArithBase.nCmdUsed) nCount++;
  6891. //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
  6892. // sArithBase.nCmdAllocated);
  6893. for(i=0; i<nCount; i++)
  6894. {
  6895. Print("%-20s",sArithBase.sCmds[i+1].name);
  6896. if(i+1+nCount<sArithBase.nCmdUsed)
  6897. Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
  6898. if(i+1+2*nCount<sArithBase.nCmdUsed)
  6899. Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
  6900. //if ((i%3)==1) PrintLn();
  6901. PrintLn();
  6902. }
  6903. PrintLn();
  6904. printBlackboxTypes();
  6905. return FALSE;
  6906. }
  6907. static BOOLEAN jjSTRING_PL(leftv res, leftv v)
  6908. {
  6909. if (v == NULL)
  6910. {
  6911. res->data = omStrDup("");
  6912. return FALSE;
  6913. }
  6914. int n = v->listLength();
  6915. if (n == 1)
  6916. {
  6917. res->data = v->String();
  6918. return FALSE;
  6919. }
  6920. char** slist = (char**) omAlloc(n*sizeof(char*));
  6921. int i, j;
  6922. for (i=0, j=0; i<n; i++, v = v ->next)
  6923. {
  6924. slist[i] = v->String();
  6925. assume(slist[i] != NULL);
  6926. j+=strlen(slist[i]);
  6927. }
  6928. char* s = (char*) omAlloc((j+1)*sizeof(char));
  6929. *s='\0';
  6930. for (i=0;i<n;i++)
  6931. {
  6932. strcat(s, slist[i]);
  6933. omFree(slist[i]);
  6934. }
  6935. omFreeSize(slist, n*sizeof(char*));
  6936. res->data = s;
  6937. return FALSE;
  6938. }
  6939. static BOOLEAN jjTEST(leftv res, leftv v)
  6940. {
  6941. do
  6942. {
  6943. if (v->Typ()!=INT_CMD)
  6944. return TRUE;
  6945. test_cmd((int)(long)v->Data());
  6946. v=v->next;
  6947. }
  6948. while (v!=NULL);
  6949. return FALSE;
  6950. }
  6951. #if defined(__alpha) && !defined(linux)
  6952. extern "C"
  6953. {
  6954. void usleep(unsigned long usec);
  6955. };
  6956. #endif
  6957. static BOOLEAN jjFactModD_M(leftv res, leftv v)
  6958. {
  6959. /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
  6960. see a detailed documentation in /kernel/linearAlgebra.h
  6961. valid argument lists:
  6962. - (poly h, int d),
  6963. - (poly h, int d, poly f0, poly g0), optional: factors of h(0,y),
  6964. - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
  6965. in list of ring vars,
  6966. - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
  6967. optional: all 4 optional args
  6968. (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
  6969. by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
  6970. has exactly two distinct monic factors [possibly with exponent > 1].)
  6971. result:
  6972. - list with the two factors f and g such that
  6973. h(x,y) = f(x,y)*g(x,y) mod x^(d+1) */
  6974. poly h = NULL;
  6975. int d = 1;
  6976. poly f0 = NULL;
  6977. poly g0 = NULL;
  6978. int xIndex = 1; /* default index if none provided */
  6979. int yIndex = 2; /* default index if none provided */
  6980. leftv u = v; int factorsGiven = 0;
  6981. if ((u == NULL) || (u->Typ() != POLY_CMD))
  6982. {
  6983. WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
  6984. return TRUE;
  6985. }
  6986. else h = (poly)u->Data();
  6987. u = u->next;
  6988. if ((u == NULL) || (u->Typ() != INT_CMD))
  6989. {
  6990. WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
  6991. return TRUE;
  6992. }
  6993. else d = (int)(long)u->Data();
  6994. u = u->next;
  6995. if ((u != NULL) && (u->Typ() == POLY_CMD))
  6996. {
  6997. if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
  6998. {
  6999. WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
  7000. return TRUE;
  7001. }
  7002. else
  7003. {
  7004. f0 = (poly)u->Data();
  7005. g0 = (poly)u->next->Data();
  7006. factorsGiven = 1;
  7007. u = u->next->next;
  7008. }
  7009. }
  7010. if ((u != NULL) && (u->Typ() == INT_CMD))
  7011. {
  7012. if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
  7013. {
  7014. WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
  7015. return TRUE;
  7016. }
  7017. else
  7018. {
  7019. xIndex = (int)(long)u->Data();
  7020. yIndex = (int)(long)u->next->Data();
  7021. u = u->next->next;
  7022. }
  7023. }
  7024. if (u != NULL)
  7025. {
  7026. WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
  7027. return TRUE;
  7028. }
  7029. /* checks for provided arguments */
  7030. if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
  7031. {
  7032. WerrorS("expected non-constant polynomial argument(s)");
  7033. return TRUE;
  7034. }
  7035. int n = rVar(currRing);
  7036. if ((xIndex < 1) || (n < xIndex))
  7037. {
  7038. Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
  7039. return TRUE;
  7040. }
  7041. if ((yIndex < 1) || (n < yIndex))
  7042. {
  7043. Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
  7044. return TRUE;
  7045. }
  7046. if (xIndex == yIndex)
  7047. {
  7048. WerrorS("expected distinct indices for variables x and y");
  7049. return TRUE;
  7050. }
  7051. /* computation of f0 and g0 if missing */
  7052. if (factorsGiven == 0)
  7053. {
  7054. #ifdef HAVE_FACTORY
  7055. poly h0 = pSubst(pCopy(h), xIndex, NULL);
  7056. intvec* v = NULL;
  7057. ideal i = singclap_factorize(h0, &v, 0);
  7058. ivTest(v);
  7059. if (i == NULL) return TRUE;
  7060. idTest(i);
  7061. if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
  7062. {
  7063. WerrorS("expected h(0,y) to have exactly two distinct monic factors");
  7064. return TRUE;
  7065. }
  7066. f0 = pPower(pCopy(i->m[1]), (*v)[1]);
  7067. g0 = pPower(pCopy(i->m[2]), (*v)[2]);
  7068. idDelete(&i);
  7069. #else
  7070. WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
  7071. return TRUE;
  7072. #endif
  7073. }
  7074. poly f; poly g;
  7075. henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
  7076. lists L = (lists)omAllocBin(slists_bin);
  7077. L->Init(2);
  7078. L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
  7079. L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
  7080. res->rtyp = LIST_CMD;
  7081. res->data = (char*)L;
  7082. return FALSE;
  7083. }
  7084. static BOOLEAN jjSTATUS_M(leftv res, leftv v)
  7085. {
  7086. if ((v->Typ() != LINK_CMD) ||
  7087. (v->next->Typ() != STRING_CMD) ||
  7088. (v->next->next->Typ() != STRING_CMD) ||
  7089. (v->next->next->next->Typ() != INT_CMD))
  7090. return TRUE;
  7091. jjSTATUS3(res, v, v->next, v->next->next);
  7092. #if defined(HAVE_USLEEP)
  7093. if (((long) res->data) == 0L)
  7094. {
  7095. int i_s = (int)(long) v->next->next->next->Data();
  7096. if (i_s > 0)
  7097. {
  7098. usleep((int)(long) v->next->next->next->Data());
  7099. jjSTATUS3(res, v, v->next, v->next->next);
  7100. }
  7101. }
  7102. #elif defined(HAVE_SLEEP)
  7103. if (((int) res->data) == 0)
  7104. {
  7105. int i_s = (int) v->next->next->next->Data();
  7106. if (i_s > 0)
  7107. {
  7108. sleep((is - 1)/1000000 + 1);
  7109. jjSTATUS3(res, v, v->next, v->next->next);
  7110. }
  7111. }
  7112. #endif
  7113. return FALSE;
  7114. }
  7115. static BOOLEAN jjSUBST_M(leftv res, leftv u)
  7116. {
  7117. leftv v = u->next; // number of args > 0
  7118. if (v==NULL) return TRUE;
  7119. leftv w = v->next;
  7120. if (w==NULL) return TRUE;
  7121. leftv rest = w->next;;
  7122. u->next = NULL;
  7123. v->next = NULL;
  7124. w->next = NULL;
  7125. BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
  7126. if ((rest!=NULL) && (!b))
  7127. {
  7128. sleftv tmp_res;
  7129. leftv tmp_next=res->next;
  7130. res->next=rest;
  7131. memset(&tmp_res,0,sizeof(tmp_res));
  7132. b = iiExprArithM(&tmp_res,res,iiOp);
  7133. memcpy(res,&tmp_res,sizeof(tmp_res));
  7134. res->next=tmp_next;
  7135. }
  7136. u->next = v;
  7137. v->next = w;
  7138. // rest was w->next, but is already cleaned
  7139. return b;
  7140. }
  7141. static BOOLEAN jjQRDS(leftv res, leftv INPUT)
  7142. {
  7143. if ((INPUT->Typ() != MATRIX_CMD) ||
  7144. (INPUT->next->Typ() != NUMBER_CMD) ||
  7145. (INPUT->next->next->Typ() != NUMBER_CMD) ||
  7146. (INPUT->next->next->next->Typ() != NUMBER_CMD))
  7147. {
  7148. WerrorS("expected (matrix, number, number, number) as arguments");
  7149. return TRUE;
  7150. }
  7151. leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
  7152. res->data = (char *)qrDoubleShift((matrix)(u->Data()),
  7153. (number)(v->Data()),
  7154. (number)(w->Data()),
  7155. (number)(x->Data()));
  7156. return FALSE;
  7157. }
  7158. static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
  7159. { ideal result;
  7160. leftv u = INPUT; /* an ideal, weighted homogeneous and standard */
  7161. leftv v = u->next; /* one additional polynomial or ideal */
  7162. leftv h = v->next; /* Hilbert vector */
  7163. leftv w = h->next; /* weight vector */
  7164. assumeStdFlag(u);
  7165. ideal i1=(ideal)(u->Data());
  7166. ideal i0;
  7167. if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
  7168. || (h->Typ()!=INTVEC_CMD)
  7169. || (w->Typ()!=INTVEC_CMD))
  7170. {
  7171. WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
  7172. return TRUE;
  7173. }
  7174. intvec *vw=(intvec *)w->Data(); // weights of vars
  7175. /* merging std_hilb_w and std_1 */
  7176. if (vw->length()!=currRing->N)
  7177. {
  7178. Werror("%d weights for %d variables",vw->length(),currRing->N);
  7179. return TRUE;
  7180. }
  7181. int r=v->Typ();
  7182. BOOLEAN cleanup_i0=FALSE;
  7183. if ((r==POLY_CMD) ||(r==VECTOR_CMD))
  7184. {
  7185. i0=idInit(1,i1->rank);
  7186. i0->m[0]=(poly)v->Data();
  7187. BOOLEAN cleanup_i0=TRUE;
  7188. }
  7189. else if (r==IDEAL_CMD)/* IDEAL */
  7190. {
  7191. i0=(ideal)v->Data();
  7192. }
  7193. else
  7194. {
  7195. WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
  7196. return TRUE;
  7197. }
  7198. int ii0=idElem(i0);
  7199. i1 = idSimpleAdd(i1,i0);
  7200. if (cleanup_i0)
  7201. {
  7202. memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
  7203. idDelete(&i0);
  7204. }
  7205. intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
  7206. tHomog hom=testHomog;
  7207. /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
  7208. if (ww!=NULL)
  7209. {
  7210. if (!idTestHomModule(i1,currQuotient,ww))
  7211. {
  7212. WarnS("wrong weights");
  7213. ww=NULL;
  7214. }
  7215. else
  7216. {
  7217. ww=ivCopy(ww);
  7218. hom=isHomog;
  7219. }
  7220. }
  7221. BITSET save_test=test;
  7222. test|=Sy_bit(OPT_SB_1);
  7223. result=kStd(i1,
  7224. currQuotient,
  7225. hom,
  7226. &ww, // module weights
  7227. (intvec *)h->Data(), // hilbert series
  7228. 0, // syzComp, whatever it is...
  7229. IDELEMS(i1)-ii0, // new ideal
  7230. vw); // weights of vars
  7231. test=save_test;
  7232. idDelete(&i1);
  7233. idSkipZeroes(result);
  7234. res->data = (char *)result;
  7235. if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
  7236. if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
  7237. return FALSE;
  7238. }
  7239. #ifdef MDEBUG
  7240. static Subexpr jjDBMakeSub(leftv e,const char *f,const int l)
  7241. #else
  7242. static Subexpr jjMakeSub(leftv e)
  7243. #endif
  7244. {
  7245. assume( e->Typ()==INT_CMD );
  7246. Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
  7247. r->start =(int)(long)e->Data();
  7248. return r;
  7249. }
  7250. #define D(A) (A)
  7251. #define IPARITH
  7252. #include "table.h"
  7253. #include <iparith.inc>
  7254. /*=================== operations with 2 args. ============================*/
  7255. /* must be ordered: first operations for chars (infix ops),
  7256. * then alphabetically */
  7257. BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
  7258. {
  7259. memset(res,0,sizeof(sleftv));
  7260. BOOLEAN call_failed=FALSE;
  7261. if (!errorreported)
  7262. {
  7263. #ifdef SIQ
  7264. if (siq>0)
  7265. {
  7266. //Print("siq:%d\n",siq);
  7267. command d=(command)omAlloc0Bin(sip_command_bin);
  7268. memcpy(&d->arg1,a,sizeof(sleftv));
  7269. //a->Init();
  7270. memcpy(&d->arg2,b,sizeof(sleftv));
  7271. //b->Init();
  7272. d->argc=2;
  7273. d->op=op;
  7274. res->data=(char *)d;
  7275. res->rtyp=COMMAND;
  7276. return FALSE;
  7277. }
  7278. #endif
  7279. int at=a->Typ();
  7280. if (at>MAX_TOK)
  7281. {
  7282. blackbox *bb=getBlackboxStuff(at);
  7283. if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
  7284. else return TRUE;
  7285. }
  7286. int bt=b->Typ();
  7287. int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
  7288. int index=i;
  7289. iiOp=op;
  7290. while (dArith2[i].cmd==op)
  7291. {
  7292. if ((at==dArith2[i].arg1)
  7293. && (bt==dArith2[i].arg2))
  7294. {
  7295. res->rtyp=dArith2[i].res;
  7296. if (currRing!=NULL)
  7297. {
  7298. if (check_valid(dArith2[i].valid_for,op)) break;
  7299. }
  7300. if (TEST_V_ALLWARN)
  7301. Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt));
  7302. if ((call_failed=dArith2[i].p(res,a,b)))
  7303. {
  7304. break;// leave loop, goto error handling
  7305. }
  7306. a->CleanUp();
  7307. b->CleanUp();
  7308. //Print("op: %d,result typ:%d\n",op,res->rtyp);
  7309. return FALSE;
  7310. }
  7311. i++;
  7312. }
  7313. // implicite type conversion ----------------------------------------------
  7314. if (dArith2[i].cmd!=op)
  7315. {
  7316. int ai,bi;
  7317. leftv an = (leftv)omAlloc0Bin(sleftv_bin);
  7318. leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
  7319. BOOLEAN failed=FALSE;
  7320. i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
  7321. //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
  7322. while (dArith2[i].cmd==op)
  7323. {
  7324. //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
  7325. if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
  7326. {
  7327. if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
  7328. {
  7329. res->rtyp=dArith2[i].res;
  7330. if (currRing!=NULL)
  7331. {
  7332. if (check_valid(dArith2[i].valid_for,op)) break;
  7333. }
  7334. if (TEST_V_ALLWARN)
  7335. Print("call %s(%s,%s)\n",Tok2Cmdname(iiOp),
  7336. Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
  7337. failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
  7338. || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
  7339. || (call_failed=dArith2[i].p(res,an,bn)));
  7340. // everything done, clean up temp. variables
  7341. if (failed)
  7342. {
  7343. // leave loop, goto error handling
  7344. break;
  7345. }
  7346. else
  7347. {
  7348. // everything ok, clean up and return
  7349. an->CleanUp();
  7350. bn->CleanUp();
  7351. omFreeBin((ADDRESS)an, sleftv_bin);
  7352. omFreeBin((ADDRESS)bn, sleftv_bin);
  7353. a->CleanUp();
  7354. b->CleanUp();
  7355. return FALSE;
  7356. }
  7357. }
  7358. }
  7359. i++;
  7360. }
  7361. an->CleanUp();
  7362. bn->CleanUp();
  7363. omFreeBin((ADDRESS)an, sleftv_bin);
  7364. omFreeBin((ADDRESS)bn, sleftv_bin);
  7365. }
  7366. // error handling ---------------------------------------------------
  7367. const char *s=NULL;
  7368. if (!errorreported)
  7369. {
  7370. if ((at==0) && (a->Fullname()!=sNoName))
  7371. {
  7372. s=a->Fullname();
  7373. }
  7374. else if ((bt==0) && (b->Fullname()!=sNoName))
  7375. {
  7376. s=b->Fullname();
  7377. }
  7378. if (s!=NULL)
  7379. Werror("`%s` is not defined",s);
  7380. else
  7381. {
  7382. i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
  7383. s = iiTwoOps(op);
  7384. if (proccall)
  7385. {
  7386. Werror("%s(`%s`,`%s`) failed"
  7387. ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
  7388. }
  7389. else
  7390. {
  7391. Werror("`%s` %s `%s` failed"
  7392. ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
  7393. }
  7394. if ((!call_failed) && BVERBOSE(V_SHOW_USE))
  7395. {
  7396. while (dArith2[i].cmd==op)
  7397. {
  7398. if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
  7399. && (dArith2[i].res!=0)
  7400. && (dArith2[i].p!=jjWRONG2))
  7401. {
  7402. if (proccall)
  7403. Werror("expected %s(`%s`,`%s`)"
  7404. ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
  7405. else
  7406. Werror("expected `%s` %s `%s`"
  7407. ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
  7408. }
  7409. i++;
  7410. }
  7411. }
  7412. }
  7413. }
  7414. res->rtyp = UNKNOWN;
  7415. }
  7416. a->CleanUp();
  7417. b->CleanUp();
  7418. return TRUE;
  7419. }
  7420. /*==================== operations with 1 arg. ===============================*/
  7421. /* must be ordered: first operations for chars (infix ops),
  7422. * then alphabetically */
  7423. BOOLEAN iiExprArith1(leftv res, leftv a, int op)
  7424. {
  7425. memset(res,0,sizeof(sleftv));
  7426. BOOLEAN call_failed=FALSE;
  7427. if (!errorreported)
  7428. {
  7429. #ifdef SIQ
  7430. if (siq>0)
  7431. {
  7432. //Print("siq:%d\n",siq);
  7433. command d=(command)omAlloc0Bin(sip_command_bin);
  7434. memcpy(&d->arg1,a,sizeof(sleftv));
  7435. //a->Init();
  7436. d->op=op;
  7437. d->argc=1;
  7438. res->data=(char *)d;
  7439. res->rtyp=COMMAND;
  7440. return FALSE;
  7441. }
  7442. #endif
  7443. int at=a->Typ();
  7444. if (at>MAX_TOK)
  7445. {
  7446. blackbox *bb=getBlackboxStuff(at);
  7447. if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
  7448. else return TRUE;
  7449. }
  7450. BOOLEAN failed=FALSE;
  7451. iiOp=op;
  7452. int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
  7453. int ti = i;
  7454. while (dArith1[i].cmd==op)
  7455. {
  7456. if (at==dArith1[i].arg)
  7457. {
  7458. int r=res->rtyp=dArith1[i].res;
  7459. if (currRing!=NULL)
  7460. {
  7461. if (check_valid(dArith1[i].valid_for,op)) break;
  7462. }
  7463. if (TEST_V_ALLWARN)
  7464. Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(at));
  7465. if (r<0)
  7466. {
  7467. res->rtyp=-r;
  7468. #ifdef PROC_BUG
  7469. dArith1[i].p(res,a);
  7470. #else
  7471. res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
  7472. #endif
  7473. }
  7474. else if ((call_failed=dArith1[i].p(res,a)))
  7475. {
  7476. break;// leave loop, goto error handling
  7477. }
  7478. if (a->Next()!=NULL)
  7479. {
  7480. res->next=(leftv)omAllocBin(sleftv_bin);
  7481. failed=iiExprArith1(res->next,a->next,op);
  7482. }
  7483. a->CleanUp();
  7484. return failed;
  7485. }
  7486. i++;
  7487. }
  7488. // implicite type conversion --------------------------------------------
  7489. if (dArith1[i].cmd!=op)
  7490. {
  7491. leftv an = (leftv)omAlloc0Bin(sleftv_bin);
  7492. i=ti;
  7493. //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
  7494. while (dArith1[i].cmd==op)
  7495. {
  7496. int ai;
  7497. //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
  7498. if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
  7499. {
  7500. int r=res->rtyp=dArith1[i].res;
  7501. if (currRing!=NULL)
  7502. {
  7503. if (check_valid(dArith1[i].valid_for,op)) break;
  7504. }
  7505. if (r<0)
  7506. {
  7507. res->rtyp=-r;
  7508. failed= iiConvert(at,dArith1[i].arg,ai,a,an);
  7509. if (!failed)
  7510. {
  7511. #ifdef PROC_BUG
  7512. dArith1[i].p(res,a);
  7513. #else
  7514. res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
  7515. #endif
  7516. }
  7517. }
  7518. else
  7519. {
  7520. failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
  7521. || (call_failed=dArith1[i].p(res,an)));
  7522. }
  7523. // everything done, clean up temp. variables
  7524. if (failed)
  7525. {
  7526. // leave loop, goto error handling
  7527. break;
  7528. }
  7529. else
  7530. {
  7531. if (TEST_V_ALLWARN)
  7532. Print("call %s(%s)\n",Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp));
  7533. if (an->Next() != NULL)
  7534. {
  7535. res->next = (leftv)omAllocBin(sleftv_bin);
  7536. failed=iiExprArith1(res->next,an->next,op);
  7537. }
  7538. // everything ok, clean up and return
  7539. an->CleanUp();
  7540. omFreeBin((ADDRESS)an, sleftv_bin);
  7541. a->CleanUp();
  7542. return failed;
  7543. }
  7544. }
  7545. i++;
  7546. }
  7547. an->CleanUp();
  7548. omFreeBin((ADDRESS)an, sleftv_bin);
  7549. }
  7550. // error handling
  7551. if (!errorreported)
  7552. {
  7553. if ((at==0) && (a->Fullname()!=sNoName))
  7554. {
  7555. Werror("`%s` is not defined",a->Fullname());
  7556. }
  7557. else
  7558. {
  7559. i=ti;
  7560. const char *s = iiTwoOps(op);
  7561. Werror("%s(`%s`) failed"
  7562. ,s,Tok2Cmdname(at));
  7563. if ((!call_failed) && BVERBOSE(V_SHOW_USE))
  7564. {
  7565. while (dArith1[i].cmd==op)
  7566. {
  7567. if ((dArith1[i].res!=0)
  7568. && (dArith1[i].p!=jjWRONG))
  7569. Werror("expected %s(`%s`)"
  7570. ,s,Tok2Cmdname(dArith1[i].arg));
  7571. i++;
  7572. }
  7573. }
  7574. }
  7575. }
  7576. res->rtyp = UNKNOWN;
  7577. }
  7578. a->CleanUp();
  7579. return TRUE;
  7580. }
  7581. /*=================== operations with 3 args. ============================*/
  7582. /* must be ordered: first operations for chars (infix ops),
  7583. * then alphabetically */
  7584. BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
  7585. {
  7586. memset(res,0,sizeof(sleftv));
  7587. BOOLEAN call_failed=FALSE;
  7588. if (!errorreported)
  7589. {
  7590. #ifdef SIQ
  7591. if (siq>0)
  7592. {
  7593. //Print("siq:%d\n",siq);
  7594. command d=(command)omAlloc0Bin(sip_command_bin);
  7595. memcpy(&d->arg1,a,sizeof(sleftv));
  7596. //a->Init();
  7597. memcpy(&d->arg2,b,sizeof(sleftv));
  7598. //b->Init();
  7599. memcpy(&d->arg3,c,sizeof(sleftv));
  7600. //c->Init();
  7601. d->op=op;
  7602. d->argc=3;
  7603. res->data=(char *)d;
  7604. res->rtyp=COMMAND;
  7605. return FALSE;
  7606. }
  7607. #endif
  7608. int at=a->Typ();
  7609. if (at>MAX_TOK)
  7610. {
  7611. blackbox *bb=getBlackboxStuff(at);
  7612. if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
  7613. else return TRUE;
  7614. }
  7615. int bt=b->Typ();
  7616. int ct=c->Typ();
  7617. iiOp=op;
  7618. int i=0;
  7619. while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
  7620. while (dArith3[i].cmd==op)
  7621. {
  7622. if ((at==dArith3[i].arg1)
  7623. && (bt==dArith3[i].arg2)
  7624. && (ct==dArith3[i].arg3))
  7625. {
  7626. res->rtyp=dArith3[i].res;
  7627. if (currRing!=NULL)
  7628. {
  7629. if (check_valid(dArith3[i].valid_for,op)) break;
  7630. }
  7631. if (TEST_V_ALLWARN)
  7632. Print("call %s(%s,%s,%s)\n",
  7633. Tok2Cmdname(iiOp),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
  7634. if ((call_failed=dArith3[i].p(res,a,b,c)))
  7635. {
  7636. break;// leave loop, goto error handling
  7637. }
  7638. a->CleanUp();
  7639. b->CleanUp();
  7640. c->CleanUp();
  7641. return FALSE;
  7642. }
  7643. i++;
  7644. }
  7645. // implicite type conversion ----------------------------------------------
  7646. if (dArith3[i].cmd!=op)
  7647. {
  7648. int ai,bi,ci;
  7649. leftv an = (leftv)omAlloc0Bin(sleftv_bin);
  7650. leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
  7651. leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
  7652. BOOLEAN failed=FALSE;
  7653. i=0;
  7654. while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
  7655. while (dArith3[i].cmd==op)
  7656. {
  7657. if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
  7658. {
  7659. if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
  7660. {
  7661. if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
  7662. {
  7663. res->rtyp=dArith3[i].res;
  7664. if (currRing!=NULL)
  7665. {
  7666. if (check_valid(dArith3[i].valid_for,op)) break;
  7667. }
  7668. if (TEST_V_ALLWARN)
  7669. Print("call %s(%s,%s,%s)\n",
  7670. Tok2Cmdname(iiOp),Tok2Cmdname(an->rtyp),
  7671. Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
  7672. failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
  7673. || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
  7674. || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
  7675. || (call_failed=dArith3[i].p(res,an,bn,cn)));
  7676. // everything done, clean up temp. variables
  7677. if (failed)
  7678. {
  7679. // leave loop, goto error handling
  7680. break;
  7681. }
  7682. else
  7683. {
  7684. // everything ok, clean up and return
  7685. an->CleanUp();
  7686. bn->CleanUp();
  7687. cn->CleanUp();
  7688. omFreeBin((ADDRESS)an, sleftv_bin);
  7689. omFreeBin((ADDRESS)bn, sleftv_bin);
  7690. omFreeBin((ADDRESS)cn, sleftv_bin);
  7691. a->CleanUp();
  7692. b->CleanUp();
  7693. c->CleanUp();
  7694. //Print("op: %d,result typ:%d\n",op,res->rtyp);
  7695. return FALSE;
  7696. }
  7697. }
  7698. }
  7699. }
  7700. i++;
  7701. }
  7702. an->CleanUp();
  7703. bn->CleanUp();
  7704. cn->CleanUp();
  7705. omFreeBin((ADDRESS)an, sleftv_bin);
  7706. omFreeBin((ADDRESS)bn, sleftv_bin);
  7707. omFreeBin((ADDRESS)cn, sleftv_bin);
  7708. }
  7709. // error handling ---------------------------------------------------
  7710. if (!errorreported)
  7711. {
  7712. const char *s=NULL;
  7713. if ((at==0) && (a->Fullname()!=sNoName))
  7714. {
  7715. s=a->Fullname();
  7716. }
  7717. else if ((bt==0) && (b->Fullname()!=sNoName))
  7718. {
  7719. s=b->Fullname();
  7720. }
  7721. else if ((ct==0) && (c->Fullname()!=sNoName))
  7722. {
  7723. s=c->Fullname();
  7724. }
  7725. if (s!=NULL)
  7726. Werror("`%s` is not defined",s);
  7727. else
  7728. {
  7729. i=0;
  7730. while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
  7731. const char *s = iiTwoOps(op);
  7732. Werror("%s(`%s`,`%s`,`%s`) failed"
  7733. ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
  7734. if ((!call_failed) && BVERBOSE(V_SHOW_USE))
  7735. {
  7736. while (dArith3[i].cmd==op)
  7737. {
  7738. if(((at==dArith3[i].arg1)
  7739. ||(bt==dArith3[i].arg2)
  7740. ||(ct==dArith3[i].arg3))
  7741. && (dArith3[i].res!=0))
  7742. {
  7743. Werror("expected %s(`%s`,`%s`,`%s`)"
  7744. ,s,Tok2Cmdname(dArith3[i].arg1)
  7745. ,Tok2Cmdname(dArith3[i].arg2)
  7746. ,Tok2Cmdname(dArith3[i].arg3));
  7747. }
  7748. i++;
  7749. }
  7750. }
  7751. }
  7752. }
  7753. res->rtyp = UNKNOWN;
  7754. }
  7755. a->CleanUp();
  7756. b->CleanUp();
  7757. c->CleanUp();
  7758. //Print("op: %d,result typ:%d\n",op,res->rtyp);
  7759. return TRUE;
  7760. }
  7761. /*==================== operations with many arg. ===============================*/
  7762. /* must be ordered: first operations for chars (infix ops),
  7763. * then alphabetically */
  7764. BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
  7765. {
  7766. // cnt = 0: all
  7767. // cnt = 1: only first one
  7768. leftv next;
  7769. BOOLEAN failed = TRUE;
  7770. if(v==NULL) return failed;
  7771. res->rtyp = LIST_CMD;
  7772. if(cnt) v->next = NULL;
  7773. next = v->next; // saving next-pointer
  7774. failed = jjLIST_PL(res, v);
  7775. v->next = next; // writeback next-pointer
  7776. return failed;
  7777. }
  7778. BOOLEAN iiExprArithM(leftv res, leftv a, int op)
  7779. {
  7780. memset(res,0,sizeof(sleftv));
  7781. if (!errorreported)
  7782. {
  7783. #ifdef SIQ
  7784. if (siq>0)
  7785. {
  7786. //Print("siq:%d\n",siq);
  7787. command d=(command)omAlloc0Bin(sip_command_bin);
  7788. d->op=op;
  7789. res->data=(char *)d;
  7790. if (a!=NULL)
  7791. {
  7792. d->argc=a->listLength();
  7793. // else : d->argc=0;
  7794. memcpy(&d->arg1,a,sizeof(sleftv));
  7795. switch(d->argc)
  7796. {
  7797. case 3:
  7798. memcpy(&d->arg3,a->next->next,sizeof(sleftv));
  7799. a->next->next->Init();
  7800. /* no break */
  7801. case 2:
  7802. memcpy(&d->arg2,a->next,sizeof(sleftv));
  7803. a->next->Init();
  7804. a->next->next=d->arg2.next;
  7805. d->arg2.next=NULL;
  7806. /* no break */
  7807. case 1:
  7808. a->Init();
  7809. a->next=d->arg1.next;
  7810. d->arg1.next=NULL;
  7811. }
  7812. if (d->argc>3) a->next=NULL;
  7813. a->name=NULL;
  7814. a->rtyp=0;
  7815. a->data=NULL;
  7816. a->e=NULL;
  7817. a->attribute=NULL;
  7818. a->CleanUp();
  7819. }
  7820. res->rtyp=COMMAND;
  7821. return FALSE;
  7822. }
  7823. #endif
  7824. if ((a!=NULL) && (a->Typ()>MAX_TOK))
  7825. {
  7826. blackbox *bb=getBlackboxStuff(a->Typ());
  7827. if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
  7828. else return TRUE;
  7829. }
  7830. BOOLEAN failed=FALSE;
  7831. int args=0;
  7832. if (a!=NULL) args=a->listLength();
  7833. iiOp=op;
  7834. int i=0;
  7835. while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
  7836. while (dArithM[i].cmd==op)
  7837. {
  7838. if ((args==dArithM[i].number_of_args)
  7839. || (dArithM[i].number_of_args==-1)
  7840. || ((dArithM[i].number_of_args==-2)&&(args>0)))
  7841. {
  7842. res->rtyp=dArithM[i].res;
  7843. if (currRing!=NULL)
  7844. {
  7845. if (check_valid(dArithM[i].valid_for,op)) break;
  7846. }
  7847. if (TEST_V_ALLWARN)
  7848. Print("call %s(... (%d args))\n", Tok2Cmdname(iiOp),args);
  7849. if (dArithM[i].p(res,a))
  7850. {
  7851. break;// leave loop, goto error handling
  7852. }
  7853. if (a!=NULL) a->CleanUp();
  7854. //Print("op: %d,result typ:%d\n",op,res->rtyp);
  7855. return failed;
  7856. }
  7857. i++;
  7858. }
  7859. // error handling
  7860. if (!errorreported)
  7861. {
  7862. if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
  7863. {
  7864. Werror("`%s` is not defined",a->Fullname());
  7865. }
  7866. else
  7867. {
  7868. const char *s = iiTwoOps(op);
  7869. Werror("%s(...) failed",s);
  7870. }
  7871. }
  7872. res->rtyp = UNKNOWN;
  7873. }
  7874. if (a!=NULL) a->CleanUp();
  7875. //Print("op: %d,result typ:%d\n",op,res->rtyp);
  7876. return TRUE;
  7877. }
  7878. /*=================== general utilities ============================*/
  7879. int IsCmd(const char *n, int & tok)
  7880. {
  7881. int i;
  7882. int an=1;
  7883. int en=sArithBase.nLastIdentifier;
  7884. loop
  7885. //for(an=0; an<sArithBase.nCmdUsed; )
  7886. {
  7887. if(an>=en-1)
  7888. {
  7889. if (strcmp(n, sArithBase.sCmds[an].name) == 0)
  7890. {
  7891. i=an;
  7892. break;
  7893. }
  7894. else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
  7895. {
  7896. i=en;
  7897. break;
  7898. }
  7899. else
  7900. {
  7901. // -- blackbox extensions:
  7902. // return 0;
  7903. return blackboxIsCmd(n,tok);
  7904. }
  7905. }
  7906. i=(an+en)/2;
  7907. if (*n < *(sArithBase.sCmds[i].name))
  7908. {
  7909. en=i-1;
  7910. }
  7911. else if (*n > *(sArithBase.sCmds[i].name))
  7912. {
  7913. an=i+1;
  7914. }
  7915. else
  7916. {
  7917. int v=strcmp(n,sArithBase.sCmds[i].name);
  7918. if(v<0)
  7919. {
  7920. en=i-1;
  7921. }
  7922. else if(v>0)
  7923. {
  7924. an=i+1;
  7925. }
  7926. else /*v==0*/
  7927. {
  7928. break;
  7929. }
  7930. }
  7931. }
  7932. lastreserved=sArithBase.sCmds[i].name;
  7933. tok=sArithBase.sCmds[i].tokval;
  7934. if(sArithBase.sCmds[i].alias==2)
  7935. {
  7936. Warn("outdated identifier `%s` used - please change your code",
  7937. sArithBase.sCmds[i].name);
  7938. sArithBase.sCmds[i].alias=1;
  7939. }
  7940. if (currRingHdl==NULL)
  7941. {
  7942. #ifdef SIQ
  7943. if (siq<=0)
  7944. {
  7945. #endif
  7946. if ((tok>=BEGIN_RING) && (tok<=END_RING))
  7947. {
  7948. WerrorS("no ring active");
  7949. return 0;
  7950. }
  7951. #ifdef SIQ
  7952. }
  7953. #endif
  7954. }
  7955. if (!expected_parms)
  7956. {
  7957. switch (tok)
  7958. {
  7959. case IDEAL_CMD:
  7960. case INT_CMD:
  7961. case INTVEC_CMD:
  7962. case MAP_CMD:
  7963. case MATRIX_CMD:
  7964. case MODUL_CMD:
  7965. case POLY_CMD:
  7966. case PROC_CMD:
  7967. case RING_CMD:
  7968. case STRING_CMD:
  7969. cmdtok = tok;
  7970. break;
  7971. }
  7972. }
  7973. return sArithBase.sCmds[i].toktype;
  7974. }
  7975. static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
  7976. {
  7977. int a=0;
  7978. int e=len;
  7979. int p=len/2;
  7980. do
  7981. {
  7982. if (op==dArithTab[p].cmd) return dArithTab[p].start;
  7983. if (op<dArithTab[p].cmd) e=p-1;
  7984. else a = p+1;
  7985. p=a+(e-a)/2;
  7986. }
  7987. while ( a <= e);
  7988. assume(0);
  7989. return 0;
  7990. }
  7991. const char * Tok2Cmdname(int tok)
  7992. {
  7993. int i = 0;
  7994. if (tok <= 0)
  7995. {
  7996. return sArithBase.sCmds[0].name;
  7997. }
  7998. if (tok==ANY_TYPE) return "any_type";
  7999. if (tok==COMMAND) return "command";
  8000. if (tok==NONE) return "nothing";
  8001. //if (tok==IFBREAK) return "if_break";
  8002. //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
  8003. //if (tok==ORDER_VECTOR) return "ordering";
  8004. //if (tok==REF_VAR) return "ref";
  8005. //if (tok==OBJECT) return "object";
  8006. //if (tok==PRINT_EXPR) return "print_expr";
  8007. if (tok==IDHDL) return "identifier";
  8008. if (tok>MAX_TOK) return getBlackboxName(tok);
  8009. for(i=0; i<sArithBase.nCmdUsed; i++)
  8010. //while (sArithBase.sCmds[i].tokval!=0)
  8011. {
  8012. if ((sArithBase.sCmds[i].tokval == tok)&&
  8013. (sArithBase.sCmds[i].alias==0))
  8014. {
  8015. return sArithBase.sCmds[i].name;
  8016. }
  8017. }
  8018. return sArithBase.sCmds[0].name;
  8019. }
  8020. /*---------------------------------------------------------------------*/
  8021. /**
  8022. * @brief compares to entry of cmdsname-list
  8023. @param[in] a
  8024. @param[in] b
  8025. @return <ReturnValue>
  8026. **/
  8027. /*---------------------------------------------------------------------*/
  8028. static int _gentable_sort_cmds( const void *a, const void *b )
  8029. {
  8030. cmdnames *pCmdL = (cmdnames*)a;
  8031. cmdnames *pCmdR = (cmdnames*)b;
  8032. if(a==NULL || b==NULL) return 0;
  8033. /* empty entries goes to the end of the list for later reuse */
  8034. if(pCmdL->name==NULL) return 1;
  8035. if(pCmdR->name==NULL) return -1;
  8036. /* $INVALID$ must come first */
  8037. if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
  8038. if(strcmp(pCmdR->name, "$INVALID$")==0) return 1;
  8039. /* tokval=-1 are reserved names at the end */
  8040. if (pCmdL->tokval==-1)
  8041. {
  8042. if (pCmdR->tokval==-1)
  8043. return strcmp(pCmdL->name, pCmdR->name);
  8044. /* pCmdL->tokval==-1, pCmdL goes at the end */
  8045. return 1;
  8046. }
  8047. /* pCmdR->tokval==-1, pCmdR goes at the end */
  8048. if(pCmdR->tokval==-1) return -1;
  8049. return strcmp(pCmdL->name, pCmdR->name);
  8050. }
  8051. /*---------------------------------------------------------------------*/
  8052. /**
  8053. * @brief initialisation of arithmetic structured data
  8054. @retval 0 on success
  8055. **/
  8056. /*---------------------------------------------------------------------*/
  8057. int iiInitArithmetic()
  8058. {
  8059. int i;
  8060. //printf("iiInitArithmetic()\n");
  8061. memset(&sArithBase, 0, sizeof(sArithBase));
  8062. iiInitCmdName();
  8063. /* fix last-identifier */
  8064. #if 0
  8065. /* we expect that gentable allready did every thing */
  8066. for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
  8067. sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
  8068. if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
  8069. }
  8070. #endif
  8071. //Print("L=%d\n", sArithBase.nLastIdentifier);
  8072. //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
  8073. //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
  8074. //iiArithAddCmd("Top", 0,-1,0);
  8075. //for(i=0; i<sArithBase.nCmdUsed; i++) {
  8076. // printf("CMD[%03d] %s, %d, %d, %d\n", i,
  8077. // sArithBase.sCmds[i].name,
  8078. // sArithBase.sCmds[i].alias,
  8079. // sArithBase.sCmds[i].tokval,
  8080. // sArithBase.sCmds[i].toktype);
  8081. //}
  8082. //iiArithRemoveCmd("Top");
  8083. //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
  8084. //iiArithRemoveCmd("mygcd");
  8085. //iiArithAddCmd("kkk", 1, 1234, CMD_1);
  8086. return 0;
  8087. }
  8088. /*---------------------------------------------------------------------*/
  8089. /**
  8090. * @brief append newitem of size sizeofitem to the list named list.
  8091. @param[in,out] list
  8092. @param[in,out] item_count
  8093. @param[in] sizeofitem
  8094. @param[in] newitem
  8095. @retval 0 success
  8096. @retval -1 failure
  8097. **/
  8098. /*---------------------------------------------------------------------*/
  8099. int iiArithAddItem2list(
  8100. void **list,
  8101. long *item_count,
  8102. long sizeofitem,
  8103. void *newitem
  8104. )
  8105. {
  8106. int count = *item_count;
  8107. //TRACE(0, "add_item_to_list(%p, %p, %ld, %p)\n", list, item_count,
  8108. // sizeofitem, newitem);
  8109. if(count==0)
  8110. {
  8111. *list = (void *)omAlloc(sizeofitem);
  8112. }
  8113. else
  8114. {
  8115. *list = (void *)omRealloc(*list, (count+1) * sizeofitem);
  8116. }
  8117. if((*list)==NULL) return -1;
  8118. //memset((*list)+count*sizeofitem, 0, sizeofitem);
  8119. //memcpy((*list)+count*sizeofitem, newitem, sizeofitem);
  8120. /* erhoehe counter um 1 */
  8121. (count)++;
  8122. *item_count = count;
  8123. return 0;
  8124. }
  8125. int iiArithFindCmd(const char *szName)
  8126. {
  8127. int an=0;
  8128. int i = 0,v = 0;
  8129. int en=sArithBase.nLastIdentifier;
  8130. loop
  8131. //for(an=0; an<sArithBase.nCmdUsed; )
  8132. {
  8133. if(an>=en-1)
  8134. {
  8135. if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
  8136. {
  8137. //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
  8138. return an;
  8139. }
  8140. else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
  8141. {
  8142. //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
  8143. return en;
  8144. }
  8145. else
  8146. {
  8147. //Print("RET- 1\n");
  8148. return -1;
  8149. }
  8150. }
  8151. i=(an+en)/2;
  8152. if (*szName < *(sArithBase.sCmds[i].name))
  8153. {
  8154. en=i-1;
  8155. }
  8156. else if (*szName > *(sArithBase.sCmds[i].name))
  8157. {
  8158. an=i+1;
  8159. }
  8160. else
  8161. {
  8162. v=strcmp(szName,sArithBase.sCmds[i].name);
  8163. if(v<0)
  8164. {
  8165. en=i-1;
  8166. }
  8167. else if(v>0)
  8168. {
  8169. an=i+1;
  8170. }
  8171. else /*v==0*/
  8172. {
  8173. //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
  8174. return i;
  8175. }
  8176. }
  8177. }
  8178. //if(i>=0 && i<sArithBase.nCmdUsed)
  8179. // return i;
  8180. //Print("RET-2\n");
  8181. return -2;
  8182. }
  8183. char *iiArithGetCmd( int nPos )
  8184. {
  8185. if(nPos<0) return NULL;
  8186. if(nPos<sArithBase.nCmdUsed)
  8187. return sArithBase.sCmds[nPos].name;
  8188. return NULL;
  8189. }
  8190. int iiArithRemoveCmd(const char *szName)
  8191. {
  8192. int nIndex;
  8193. if(szName==NULL) return -1;
  8194. nIndex = iiArithFindCmd(szName);
  8195. if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
  8196. {
  8197. Print("'%s' not found (%d)\n", szName, nIndex);
  8198. return -1;
  8199. }
  8200. omFree(sArithBase.sCmds[nIndex].name);
  8201. sArithBase.sCmds[nIndex].name=NULL;
  8202. qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
  8203. (&_gentable_sort_cmds));
  8204. sArithBase.nCmdUsed--;
  8205. /* fix last-identifier */
  8206. for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
  8207. sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
  8208. {
  8209. if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
  8210. }
  8211. //Print("L=%d\n", sArithBase.nLastIdentifier);
  8212. return 0;
  8213. }
  8214. int iiArithAddCmd(
  8215. const char *szName,
  8216. short nAlias,
  8217. short nTokval,
  8218. short nToktype,
  8219. short nPos
  8220. )
  8221. {
  8222. //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
  8223. // nTokval, nToktype, nPos);
  8224. if(nPos>=0)
  8225. {
  8226. // no checks: we rely on a correct generated code in iparith.inc
  8227. assume(nPos < sArithBase.nCmdAllocated);
  8228. assume(szName!=NULL);
  8229. sArithBase.sCmds[nPos].name = omStrDup(szName);
  8230. sArithBase.sCmds[nPos].alias = nAlias;
  8231. sArithBase.sCmds[nPos].tokval = nTokval;
  8232. sArithBase.sCmds[nPos].toktype = nToktype;
  8233. sArithBase.nCmdUsed++;
  8234. //if(nTokval>0) sArithBase.nLastIdentifier++;
  8235. }
  8236. else
  8237. {
  8238. if(szName==NULL) return -1;
  8239. int nIndex = iiArithFindCmd(szName);
  8240. if(nIndex>=0)
  8241. {
  8242. Print("'%s' already exists at %d\n", szName, nIndex);
  8243. return -1;
  8244. }
  8245. if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
  8246. {
  8247. /* needs to create new slots */
  8248. unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
  8249. sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
  8250. if(sArithBase.sCmds==NULL) return -1;
  8251. sArithBase.nCmdAllocated++;
  8252. }
  8253. /* still free slots available */
  8254. sArithBase.sCmds[sArithBase.nCmdUsed].name = omStrDup(szName);
  8255. sArithBase.sCmds[sArithBase.nCmdUsed].alias = nAlias;
  8256. sArithBase.sCmds[sArithBase.nCmdUsed].tokval = nTokval;
  8257. sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
  8258. sArithBase.nCmdUsed++;
  8259. qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
  8260. (&_gentable_sort_cmds));
  8261. for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
  8262. sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
  8263. {
  8264. if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
  8265. }
  8266. //Print("L=%d\n", sArithBase.nLastIdentifier);
  8267. }
  8268. return 0;
  8269. }
  8270. static BOOLEAN check_valid(const int p, const int op)
  8271. {
  8272. #ifdef HAVE_PLURAL
  8273. if (rIsPluralRing(currRing))
  8274. {
  8275. if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
  8276. {
  8277. WerrorS("not implemented for non-commutative rings");
  8278. return TRUE;
  8279. }
  8280. else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
  8281. {
  8282. Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
  8283. return FALSE;
  8284. }
  8285. /* else, ALLOW_PLURAL */
  8286. }
  8287. #endif
  8288. #ifdef HAVE_RINGS
  8289. if (rField_is_Ring(currRing))
  8290. {
  8291. if ((p & RING_MASK)==0 /*NO_RING*/)
  8292. {
  8293. WerrorS("not implemented for rings with rings as coeffients");
  8294. return TRUE;
  8295. }
  8296. /* else ALLOW_RING */
  8297. else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
  8298. &&(!rField_is_Domain(currRing)))
  8299. {
  8300. WerrorS("domain required as coeffients");
  8301. return TRUE;
  8302. }
  8303. /* else ALLOW_ZERODIVISOR */
  8304. }
  8305. #endif
  8306. return FALSE;
  8307. }