source: git/Singular/mpsr_Get.cc @ 06c0b3

spielwiese
Last change on this file since 06c0b3 was 762407, checked in by Oleksandr Motsak <motsak@…>, 12 years ago
config.h is for sources files only FIX: config.h should only be used by source (not from inside kernel/mod2.h!) NOTE: each source file should better include mod2.h right after config.h, while headers should better not include mod2.h.
  • Property mode set to 100644
File size: 25.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/* $Id$ */
6/***************************************************************
7 *
8 * File:       mpsr_Get.cc
9 * Purpose:    definition of the main Get routine(s)
10 * Author:     Olaf Bachmann (10/95)
11 *
12 * Change History (most recent first):
13 *
14 ***************************************************************/
15
16#include "config.h"
17#include <kernel/mod2.h>
18
19#ifdef HAVE_MPSR
20
21
22#include"mpsr_Get.h"
23#include"mpsr_Tok.h"
24
25#include <Singular/tok.h>
26#include <kernel/longrat.h>
27#include <misc/intvec.h>
28#include <kernel/ideals.h>
29#include <polys/matpol.h>
30#include <Singular/lists.h>
31
32#include <misc/mylimits.h>
33
34omBin mpsr_sleftv_bin = omGetSpecBin(sizeof(mpsr_sleftv));
35
36/***************************************************************
37 *
38 * prototypes
39 *
40 ***************************************************************/
41static mpsr_Status_t GetIntVecLeftv(MP_Link_pt link, MPT_Node_pt node,
42                                  mpsr_leftv mlv);
43static mpsr_Status_t GetIntMatLeftv(MP_Link_pt link, MPT_Node_pt node,
44                                  mpsr_leftv mlv);
45static mpsr_Status_t GetRingLeftv(MP_Link_pt link, MPT_Node_pt node,
46                                mpsr_leftv mlv);
47static mpsr_Status_t GetPolyLeftv(MP_Link_pt link, MPT_Node_pt node,
48                                mpsr_leftv mlv, BOOLEAN IsUnOrdered);
49static mpsr_Status_t GetPolyVectorLeftv(MP_Link_pt link, MPT_Node_pt node,
50                                        mpsr_leftv mlv,
51                                        BOOLEAN IsUnOrdered = FALSE);
52static mpsr_Status_t GetIdealLeftv(MP_Link_pt link, MPT_Node_pt node,
53                                 mpsr_leftv mlv, BOOLEAN IsUnOrdered = FALSE);
54static mpsr_Status_t GetModuleLeftv(MP_Link_pt link, MPT_Node_pt node,
55                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered = FALSE);
56static mpsr_Status_t GetMatrixLeftv(MP_Link_pt link, MPT_Node_pt node,
57                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered = FALSE);
58static mpsr_Status_t GetMapLeftv(MP_Link_pt link, MPT_Node_pt node,
59                               mpsr_leftv mlv);
60static mpsr_Status_t GetCopCommandLeftv(MP_Link_pt link, MPT_Node_pt node,
61                                      mpsr_leftv mlv, short quote);
62
63/***************************************************************
64 *
65 * Inlines
66 *
67 ***************************************************************/
68
69//
70// Predicates which examine nodes for primitive Singular types
71//
72#define fr(cond)    if (! (cond)) return FALSE
73
74static inline BOOLEAN IsIntVecNode(MPT_Node_pt node)
75{
76  fr(NodeCheck(node, MP_MatrixDict, MP_CopMatrixDenseVector));
77
78  MPT_Tree_pt tree = MPT_ProtoAnnotValue(node);
79  return tree != NULL && NodeCheck(tree->node, MP_CommonMetaType,
80                                   MP_ProtoDict, MP_CmtProtoIMP_Sint32);
81}
82
83static inline BOOLEAN IsIntMatNode(MPT_Node_pt node)
84{
85  fr(NodeCheck(node, MP_MatrixDict, MP_CopMatrixDenseMatrix));
86
87  MPT_Tree_pt tree = MPT_ProtoAnnotValue(node);
88  return tree != NULL && NodeCheck(tree->node, MP_CommonMetaType,
89                                   MP_ProtoDict, MP_CmtProtoIMP_Sint32);
90}
91
92static inline BOOLEAN IsRingNode(MPT_Node_pt node, ring &r, BOOLEAN &IsUnOrdered)
93{
94  BOOLEAN mv;
95  return
96    NodeCheck(node, MP_PolyDict, MP_CopPolyRing) &&
97    mpsr_GetRingAnnots(node, r, mv, IsUnOrdered) == mpsr_Success;
98}
99
100static inline BOOLEAN IsPolyNode(MPT_Node_pt node, ring &r, BOOLEAN &IsUnOrdered)
101{
102  BOOLEAN mv;
103
104  //for the timne being, we only accept DDP's
105  return
106    NodeCheck(node, MP_PolyDict, MP_CopPolyDenseDistPoly) &&
107    MPT_Annot(node, MP_PolyDict, MP_AnnotPolyModuleVector) == NULL &&
108    mpsr_GetRingAnnots(node, r, mv, IsUnOrdered) == mpsr_Success;
109}
110
111static inline BOOLEAN IsPolyVectorNode(MPT_Node_pt node, ring &r,
112                                BOOLEAN &IsUnOrdered)
113{
114  BOOLEAN mv;
115
116  //for the timne being, we only accept DDP's
117  return
118    NodeCheck(node, MP_PolyDict, MP_CopPolyDenseDistPoly) &&
119    MPT_Annot(node, MP_PolyDict, MP_AnnotPolyModuleVector) != NULL &&
120    mpsr_GetRingAnnots(node, r, mv, IsUnOrdered) == mpsr_Success;
121}
122
123static inline BOOLEAN IsIdealNode(MPT_Node_pt node, ring &r,
124                           BOOLEAN &IsUnOrdered)
125{
126  fr(NodeCheck(node, MP_PolyDict, MP_CopPolyIdeal));
127  MPT_Tree_pt tree = MPT_ProtoAnnotValue(node);
128  fr(tree != NULL);
129  node = tree->node;
130  return
131    node->type == MP_CommonMetaOperatorType &&
132    node->numchild == 0 &&
133    IsPolyNode(node, r, IsUnOrdered);
134}
135
136static inline BOOLEAN IsModuleNode(MPT_Node_pt node, ring &r, BOOLEAN &IsUnOrdered)
137{
138  fr(NodeCheck(node, MP_PolyDict, MP_CopPolyModule));
139  MPT_Tree_pt tree = MPT_ProtoAnnotValue(node);
140  fr(tree != NULL);
141  node = tree->node;
142  return
143    node->type == MP_CommonMetaOperatorType &&
144    node->numchild == 0 &&
145    IsPolyVectorNode(node, r, IsUnOrdered);
146}
147
148static inline BOOLEAN IsMatrixNode(MPT_Node_pt node, ring &r, BOOLEAN &IsUnOrdered)
149{
150  fr(NodeCheck(node, MP_MatrixDict, MP_CopMatrixDenseMatrix));
151  MPT_Tree_pt tree = MPT_ProtoAnnotValue(node);
152  fr(tree != NULL);
153  node = tree->node;
154  return
155    node->type == MP_CommonMetaOperatorType &&
156    node->numchild == 0 &&
157    IsPolyNode(node, r, IsUnOrdered);
158}
159
160static inline BOOLEAN IsQuitNode(MPT_Node_pt node)
161{
162  return NodeCheck(node, MP_MpDict, MP_CopMpEndSession);
163}
164
165//
166// Init*Leftv functions
167//
168static inline void InitIntLeftv(mpsr_leftv mlv, int i)
169{
170  mlv->lv = mpsr_InitLeftv(INT_CMD, (void *) i);
171}
172
173static inline void InitApIntLeftv(mpsr_leftv mlv, mpz_ptr apint)
174{
175  number n = (number) ALLOC_RNUMBER();
176#if defined(LDEBUG)
177    n->debug=123456;
178#endif
179  mlv->r = mpsr_rDefault(0);
180  n->s = 3;
181  memcpy(&(n->z), apint, sizeof(mpz_t));
182  nlNormalize(n);
183  omFreeSize(apint, sizeof(mpz_t));
184  mlv->lv = mpsr_InitLeftv(NUMBER_CMD, n);
185}
186
187static inline void InitReal32Leftv(mpsr_leftv mlv, MPT_Arg_t r32)
188{
189  number n = (number) r32;
190//  n = Real32_2_Number(r32);
191
192  mlv->r = mpsr_rDefault(-1);
193  mlv->lv = mpsr_InitLeftv(NUMBER_CMD, n);
194}
195
196static inline void InitIdentifierLeftv(mpsr_leftv mlv, char *name, short quote)
197{
198  int pos;
199
200  if (quote <= 0)
201  {
202    idhdl h = mpsr_FindIdhdl(name, mlv->r);
203
204    if (h != NULL)
205    {
206      mlv->lv = mpsr_InitLeftv(IDHDL, (void *) h);
207    }
208    else if (strcmp(name, "basering") == 0)
209    {
210      mlv->lv = mpsr_InitLeftv(IDHDL, (void*) currRingHdl);
211      mlv->lv->name=IDID(currRingHdl);
212      mlv->lv->attribute=IDATTR(currRingHdl);
213    }
214    else
215    {
216      poly p;
217
218      pos = mpsr_rDefault(0, name, mlv->r);
219      mpsr_SetCurrRing(mlv->r, TRUE);
220      p = pOne();
221      pSetExp(p,pos+1, 1);
222      pSetm(p);
223      mlv->lv = mpsr_InitLeftv(POLY_CMD, (void *) p);
224    }
225    omFree(name);
226  }
227  else
228  {
229    mlv->lv = mpsr_InitLeftv(DEF_CMD, NULL);
230    mlv->lv->name = name;
231  }
232}
233
234/* primitive mpsr_Get*Leftv functions */
235
236static inline mpsr_Status_t mpsr_GetIntLeftv(MPT_Node_pt node, mpsr_leftv mlv)
237{
238  mpsr_assume(MP_IsFixedIntegerType(node->type));
239  mlv->lv = mpsr_InitLeftv(INT_CMD, node->nvalue);
240  return mpsr_Success;
241}
242
243static inline mpsr_Status_t mpsr_GetReal32Leftv(MPT_Node_pt node, mpsr_leftv mlv)
244{
245  mpsr_assume(node->type == MP_Real32Type);
246  InitReal32Leftv(mlv, node->nvalue);
247  return mpsr_Success;
248}
249
250static inline mpsr_Status_t mpsr_GetApIntLeftv(MPT_Node_pt node, mpsr_leftv mlv)
251{
252  InitApIntLeftv(mlv, (mpz_ptr)  node->nvalue);
253  node->nvalue = NULL;
254  return mpsr_Success;
255}
256
257static inline mpsr_Status_t mpsr_GetIdentifierLeftv(MPT_Node_pt node, mpsr_leftv mlv,
258                                             short quote)
259{
260  mpsr_assume(MP_IsIdType(node->type));
261  char *id;
262  MPT_Annot_pt proc_annot = MPT_Annot(node, MP_SingularDict,
263                                      MP_AnnotSingularProcDef);
264
265  if (node->type == MP_CommonGreekIdentifierType ||
266      node->type == MP_CommonGreekIdentifierType)
267  {
268    id  = (char *) omAlloc(2*sizeof(char));
269    id[1] = '\0';
270    id[0] = MP_UINT8_T(node->nvalue);
271  }
272  else
273  {
274    id = MP_STRING_T(node->nvalue);
275    node->nvalue = NULL;
276  }
277
278  InitIdentifierLeftv(mlv, id, quote);
279
280  if (proc_annot != NULL) mlv->lv->rtyp = PROC_CMD;
281
282  return mpsr_Success;
283}
284
285static inline mpsr_Status_t mpsr_GetStringLeftv(MPT_Node_pt node, mpsr_leftv mlv)
286{
287  mpsr_assume(node->type == MP_StringType);
288  mlv->lv = mpsr_InitLeftv(STRING_CMD, MP_STRING_T(node->nvalue));
289  node->nvalue = NULL;
290  return mpsr_Success;
291}
292
293static inline mpsr_Status_t GetQuitLeftv(mpsr_leftv mlv)
294{
295  mlv->lv = mpsr_InitLeftv(STRING_CMD, (void *) omStrDup(MPSR_QUIT_STRING));
296  return mpsr_Success;
297}
298
299/***************************************************************
300 *
301 * The top-level routine for getting a message
302 *
303 ***************************************************************/
304mpsr_Status_t mpsr_GetMsg(MP_Link_pt link, leftv &lv)
305{
306  mpsr_sleftv mlv, mlv1;
307  mpsr_Status_t status = mpsr_Success;
308  mlv.lv = NULL;
309  mlv.r = NULL;
310  mlv1.lv = NULL;
311  mlv1.r = NULL;
312
313  status = (MP_InitMsg(link) == MP_Success ? mpsr_Success : mpsr_MP_Failure);
314
315  if (status == mpsr_Success && ! MP_TestEofMsg(link))
316    status = mpsr_GetLeftv(link, &mlv, 0);
317  else
318  {
319    lv = mpsr_InitLeftv(NONE, NULL);
320    return status;
321  }
322
323  // handle more than one leftv (ie. chains of leftv's)
324  while (status == mpsr_Success && ! MP_TestEofMsg(link))
325  {
326    // Get next leftv
327    status = mpsr_GetLeftv(link, &mlv1, 0);
328    if (status == mpsr_Success)
329      status = mpsr_MergeLeftv(&mlv, &mlv1);
330  }
331
332  if (status == mpsr_Success)
333  {
334    // Now mlv is our leftv -- check whether r has an ordering set
335    if (mlv.r != NULL && mlv.r->order[0] == ringorder_unspec)
336    {
337        ring r = rCopy(mlv.r);
338        r->order[0] = ringorder_dp;
339        mpsr_rSetOrdSgn(r);
340        mpsr_MapLeftv(mlv.lv, mlv.r, r);
341        rKill(mlv.r);
342        mlv.r = r;
343    }
344
345    mpsr_SetCurrRingHdl(&mlv);
346
347    lv = mlv.lv;
348  }
349  else lv = mpsr_InitLeftv(NONE, NULL);
350
351  return status;
352}
353
354/***************************************************************
355 *
356 * Top-level routine for getting a mpsr_leftv
357 *
358 ***************************************************************/
359
360// if quote > 0, then identifiers are not tried to be resolved, or
361// converted into a ring variable
362mpsr_Status_t mpsr_GetLeftv(MP_Link_pt link, mpsr_leftv mlv, short quote)
363{
364  MPT_Node_pt node = NULL;
365  MP_NodeType_t type;
366  mlv->r = NULL;
367  mlv->lv = NULL;
368
369  mpt_failr(MPT_GetNode(link, &node));
370
371  type = node->type;
372
373  if (MP_IsFixedIntegerType(type))
374    failr(mpsr_GetIntLeftv(node, mlv));
375  else if (MP_IsIdType(type))
376    failr(mpsr_GetIdentifierLeftv(node, mlv, quote));
377  else
378  {
379    switch (node->type)
380    {
381        case MP_ApIntType:
382          failr(mpsr_GetApIntLeftv(node, mlv));
383          break;
384
385        case MP_StringType:
386          failr(mpsr_GetStringLeftv(node, mlv));
387          break;
388
389        case MP_Real32Type:
390          failr(mpsr_GetReal32Leftv(node, mlv));
391          break;
392
393        case MP_CommonOperatorType:
394          failr(mpsr_GetCommonOperatorLeftv(link, node, mlv, quote));
395          break;
396
397        case MP_OperatorType:
398          failr(mpsr_GetOperatorLeftv(link, node, mlv, quote));
399          break;
400
401        default:
402          MPT_DeleteNode(node);
403          return mpsr_SetError(mpsr_UnknownMPNodeType);
404    }
405  }
406
407  // everything was ok
408  MPT_DeleteNode(node);
409  return mpsr_Success;
410}
411
412/***************************************************************
413 *
414 * mpsr_Get*Leftv
415 *
416 ***************************************************************/
417mpsr_Status_t mpsr_GetCommonOperatorLeftv(MP_Link_pt link,
418                                          MPT_Node_pt node,
419                                          mpsr_leftv mlv,
420                                          short quote)
421{
422  mpsr_assume(node->type == MP_CommonOperatorType);
423  BOOLEAN IsUnOrdered;
424
425  // Check for Singular data types
426  // IntVec
427  if (IsIntVecNode(node))
428    return GetIntVecLeftv(link, node, mlv);
429  // IntMat
430  else if (IsIntMatNode(node))
431    return GetIntMatLeftv(link, node, mlv);
432  // Ring
433  else if (IsRingNode(node, mlv->r, IsUnOrdered))
434    return GetRingLeftv(link, node, mlv);
435  // Poly
436  else if (IsPolyNode(node, mlv->r, IsUnOrdered))
437    return GetPolyLeftv(link, node, mlv, IsUnOrdered);
438  // PolyVector
439  else if (IsPolyVectorNode(node, mlv->r, IsUnOrdered))
440    return GetPolyVectorLeftv(link, node, mlv, IsUnOrdered);
441  // Ideal
442  else if (IsIdealNode(node, mlv->r, IsUnOrdered))
443    return GetIdealLeftv(link, node, mlv, IsUnOrdered);
444  // Module
445  else if (IsModuleNode(node, mlv->r, IsUnOrdered))
446    return GetModuleLeftv(link, node, mlv, IsUnOrdered);
447  // Matrix
448  else if (IsMatrixNode(node, mlv->r, IsUnOrdered))
449    return GetMatrixLeftv(link, node, mlv, IsUnOrdered);
450  else if (IsQuitNode(node))
451    return GetQuitLeftv(mlv);
452  // Map
453  else
454    // now it should be a command (which handles Proc, Map and List
455    // seperately)
456    return GetCopCommandLeftv(link, node, mlv, quote);
457}
458
459mpsr_Status_t mpsr_GetOperatorLeftv(MP_Link_pt link,
460                                  MPT_Node_pt node,
461                                  mpsr_leftv mlv,
462                                  short quote)
463{
464  mpsr_assume(node->type == MP_OperatorType);
465  MP_NumChild_t nc = node->numchild, i;
466  mpsr_sleftv smlv1, *mlv1 = &smlv1;
467
468
469  if (MPT_ProtoAnnotValue(node) != NULL)
470    return mpsr_SetError(mpsr_CanNotHandlePrototype);
471
472  if (nc > 0)
473  {
474    failr(mpsr_GetLeftv(link, mlv, quote));
475    for (i=1; i<nc; i++)
476    {
477      failr(mpsr_GetLeftv(link, mlv1, quote));
478      failr(mpsr_MergeLeftv(mlv, mlv1));
479    }
480  }
481
482  command cmd = (command) omAlloc0Bin(sip_command_bin);
483  cmd->op = PROC_CMD;
484  cmd->arg1.rtyp = STRING_CMD;
485  cmd->arg1.data = (void *) omStrDup(MP_STRING_T(node->nvalue));
486
487  if (node->numchild > 0)
488  {
489    cmd->argc = 2;
490    memcpy(&(cmd->arg2), mlv->lv, sizeof(sleftv));
491    omFreeBin(mlv->lv, sleftv_bin);
492  }
493  else cmd->argc = 1;
494
495  mlv->lv = mpsr_InitLeftv(COMMAND, (void *) cmd);
496  return mpsr_Success;
497}
498
499/***************************************************************
500 *
501 * Get*Leftv routines
502 *
503 ***************************************************************/
504//
505// Get*Leftv routines
506//
507static mpsr_Status_t GetIntVecLeftv(MP_Link_pt link, MPT_Node_pt node,
508                                  mpsr_leftv mlv)
509{
510  intvec *iv = new intvec(node->numchild);
511  int *v = iv->ivGetVec();
512
513  mp_failr(IMP_GetSint32Vector(link, &v, node->numchild));
514  mlv->lv = mpsr_InitLeftv(INTVEC_CMD, (void *) iv);
515  return mpsr_Success;
516}
517
518static mpsr_Status_t GetIntMatLeftv(MP_Link_pt link, MPT_Node_pt node,
519                                  mpsr_leftv mlv)
520{
521  intvec *iv;
522  int row = node->numchild, col = 1, *v;
523  MPT_Annot_pt annot = MPT_Annot(node, MP_MatrixDict,
524                                 MP_AnnotMatrixDimension);
525  if (annot != NULL &&
526      annot->value != NULL &&
527      annot->value->node->numchild == 2 &&
528      NodeCheck(annot->value->node, MP_CommonOperatorType, MP_BasicDict,
529                MP_CopBasicList))
530  {
531    MPT_Tree_pt *tarray = (MPT_Tree_pt *) annot->value->args;
532    if (tarray[0]->node->type == MP_Sint32Type &&
533        tarray[1]->node->type == MP_Sint32Type)
534    {
535      row = MP_SINT32_T(tarray[0]->node->nvalue);
536      col = MP_SINT32_T(tarray[1]->node->nvalue);
537    }
538  }
539
540  iv = new intvec(row, col, 0);
541  v = iv->ivGetVec();
542  mp_failr(IMP_GetSint32Vector(link, &v, node->numchild));
543  mlv->lv = mpsr_InitLeftv(INTMAT_CMD, (void *) iv);
544  return mpsr_Success;
545}
546
547static mpsr_Status_t GetRingLeftv(MP_Link_pt link, MPT_Node_pt node,
548                                mpsr_leftv mlv)
549{
550  mpsr_assume(mlv->r != NULL);
551
552  if (node->numchild != 0) mpt_failr(MPT_SkipArgs(link, node));
553
554  mlv->lv = mpsr_InitLeftv(((mlv->r->qideal != NULL) ? (short) QRING_CMD :
555                            (short) RING_CMD),
556                           (void *) mlv->r);
557  mlv->r = NULL;
558  return mpsr_Success;
559}
560
561static mpsr_Status_t GetPolyLeftv(MP_Link_pt link, MPT_Node_pt node,
562                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered)
563{
564  poly p;
565
566  mpsr_assume(mlv->r != NULL);
567
568  failr(mpsr_GetPoly(link, p, node->numchild, mlv->r));
569  if (IsUnOrdered) p = pSort(p);
570  pTest(p);
571  mlv->lv = mpsr_InitLeftv(POLY_CMD, (void *) p);
572  return mpsr_Success;
573}
574
575static mpsr_Status_t GetPolyVectorLeftv(MP_Link_pt link, MPT_Node_pt node,
576                                      mpsr_leftv mlv, BOOLEAN IsUnOrdered)
577{
578  poly p;
579
580  mpsr_assume(mlv->r != NULL);
581
582  failr(mpsr_GetPolyVector(link, p, node->numchild, mlv->r));
583  if (IsUnOrdered) p = pSort(p);
584  pTest(p);
585  mlv->lv = mpsr_InitLeftv(VECTOR_CMD, (void *) p);
586  return mpsr_Success;
587}
588
589static mpsr_Status_t GetIdealLeftv(MP_Link_pt link, MPT_Node_pt node,
590                                 mpsr_leftv mlv, BOOLEAN IsUnOrdered)
591{
592  MP_NumChild_t nc = node->numchild, i;
593  ring r = mlv->r;
594  MP_Uint32_t nmon;
595
596  mpsr_assume(r != NULL);
597  ideal id = idInit(nc,1);
598  for (i=0; i<nc; i++)
599  {
600    mp_failr(IMP_GetUint32(link, &nmon));
601    failr(mpsr_GetPoly(link, id->m[i], nmon, r));
602    if (IsUnOrdered) id->m[i] = pSort(id->m[i]);
603  }
604  idTest(id);
605  mlv->lv = mpsr_InitLeftv(IDEAL_CMD, (void *) id);
606  return mpsr_Success;
607}
608
609static mpsr_Status_t GetModuleLeftv(MP_Link_pt link, MPT_Node_pt node,
610                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered)
611{
612  MP_NumChild_t nc = node->numchild, i;
613  ring r = mlv->r;
614  MP_Uint32_t nmon, rank = 1;
615  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict,
616                                     MP_AnnotPolyModuleRank);
617  if (annot != NULL &&
618      annot->value != NULL &&
619      annot->value->node->type == MP_Uint32Type
620      )
621    rank = MP_UINT32_T(annot->value->node->nvalue);
622
623  mpsr_assume(r != NULL);
624  ideal id = idInit(nc,rank);
625  for (i=0; i<nc; i++)
626  {
627    mp_failr(IMP_GetUint32(link, &nmon));
628    failr(mpsr_GetPolyVector(link, id->m[i], nmon, r));
629    if (IsUnOrdered) id->m[i] = pSort(id->m[i]);
630  }
631  if (rank == 1)
632    id->rank = id_RankFreeModule(id, currRing);
633  idTest(id);
634  mlv->lv = mpsr_InitLeftv(MODUL_CMD, (void *) id);
635  return mpsr_Success;
636}
637
638static mpsr_Status_t GetMatrixLeftv(MP_Link_pt link, MPT_Node_pt node,
639                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered)
640{
641  MP_NumChild_t nc = node->numchild, row = nc, col = 1, i;
642  matrix mp;
643  MP_Uint32_t nmon;
644  MPT_Annot_pt annot = MPT_Annot(node, MP_MatrixDict,
645                                     MP_AnnotMatrixDimension);
646  if (annot != NULL &&
647      annot->value != NULL &&
648      annot->value->node->numchild == 2 &&
649      NodeCheck(annot->value->node, MP_CommonOperatorType, MP_BasicDict,
650               MP_CopBasicList))
651  {
652    MPT_Tree_pt *tarray = (MPT_Tree_pt *) annot->value->args;
653    if (tarray[0]->node->type == MP_Sint32Type &&
654        tarray[1]->node->type == MP_Sint32Type)
655    {
656      row = MP_SINT32_T(tarray[0]->node->nvalue);
657      col = MP_SINT32_T(tarray[1]->node->nvalue);
658    }
659  }
660
661  mpsr_assume(mlv->r != NULL);
662  mp = mpNew(row, col);
663  for (i=0; i<nc; i++)
664  {
665    mp_failr(IMP_GetUint32(link, &nmon));
666    failr(mpsr_GetPoly(link, mp->m[i], nmon, mlv->r));
667    if (IsUnOrdered) mp->m[i] = pSort(mp->m[i]);
668  }
669
670  mlv->lv = mpsr_InitLeftv(MATRIX_CMD, (void *) mp);
671  return mpsr_Success;
672}
673
674static mpsr_Status_t GetPackageLeftv(MP_Link_pt link, MPT_Node_pt node,
675                                     mpsr_leftv mlv)
676{
677  package pack = (package) omAlloc0Bin(sip_package_bin);
678
679  pack->language = LANG_NONE;
680
681  if (node->numchild > 0)
682  {
683    failr(mpsr_GetLeftv(link, mlv, 0));
684    if (mlv->lv->rtyp != STRING_CMD)
685      return mpsr_SetError(mpsr_WrongArgumentType);
686    pack->libname = (char*) mlv->lv->data;
687    mlv->lv->rtyp = PACKAGE_CMD;
688  }
689  else
690    mlv->lv = mpsr_InitLeftv(PACKAGE_CMD, NULL);
691
692  mlv->lv->data = (void*) pack;
693
694  MPT_Annot_pt annot = MPT_Annot(node, MP_SingularDict,
695                                 MP_AnnotSingularPackageType);
696  if (annot != NULL && annot->value != NULL && annot->value->node)
697  {
698    MPT_Node_pt node = annot->value->node;
699    if (node->type == MP_Uint8Type && MP_UINT8_T(node->nvalue) < LANG_MAX)
700      pack->language =  (language_defs) MP_UINT8_T(node->nvalue);
701  }
702  return mpsr_Success;
703}
704
705
706static mpsr_Status_t GetMapLeftv(MP_Link_pt link, MPT_Node_pt node,
707                               mpsr_leftv mlv)
708{
709  mpsr_sleftv smlv1, smlv2, *mlv1 = &smlv1, *mlv2 = &smlv2;
710
711  if (node->numchild != 3)
712    return mpsr_SetError(mpsr_WrongNumofArgs);
713
714  failr(mpsr_GetLeftv(link, mlv, 0));
715  failr(mpsr_GetLeftv(link, mlv1, 0));
716  failr(mpsr_GetLeftv(link, mlv2, 0));
717
718  if (mlv->lv->rtyp != RING_CMD ||
719      mlv1->lv->rtyp != STRING_CMD ||
720      mlv2->lv->rtyp != IDEAL_CMD)
721    return mpsr_SetError(mpsr_WrongArgumentType);
722
723  ring r = (ring) mlv->lv->data, r2;
724  char *name = (char *) mlv1->lv->data;
725  ideal id = (ideal) mlv2->lv->data;
726
727  idhdl h = mpsr_FindIdhdl(name, r2);
728  if (h == NULL || IDTYP(h) != RING_CMD || ! rEqual(IDRING(h), r))
729  {
730    h = mpsr_InitIdhdl(RING_CMD, r, name);
731    h->next = IDROOT;
732    IDROOT = h;
733  }
734
735  map m = (map) omAlloc0Bin(sip_sideal_bin);
736  m->preimage = omStrDup(name);
737  m->m = id->m;
738  m->nrows = id->nrows;
739  m->ncols = id->ncols;
740
741  omFreeBin(mlv->lv, sleftv_bin);
742
743  omFree(mlv1->lv->data);
744  omFreeBin(mlv1->lv, sleftv_bin);
745
746  omFreeBin(id, sip_sideal_bin);
747  omFreeBin(mlv2->lv, sleftv_bin);
748
749  mlv->r = mlv2->r;
750  mlv->lv = mpsr_InitLeftv(MAP_CMD, (void *) m);
751
752  return mpsr_Success;
753}
754
755
756static mpsr_Status_t GetCopCommandLeftv(MP_Link_pt link, MPT_Node_pt node,
757                                        mpsr_leftv mlv, short quote)
758{
759  short tok;
760  MP_NumChild_t nc = node->numchild, i;
761  mpsr_sleftv smlv1, *mlv1 = &smlv1;
762  MPT_Tree_pt typespec;
763
764
765  failr(mpsr_mp2tok(node->dict, MP_COMMON_T(node->nvalue), &tok));
766
767  if ((typespec = MPT_ProtoAnnotValue(node)) &&
768      MPT_IsTrueProtoTypeSpec(typespec))
769    return mpsr_SetError(mpsr_CanNotHandlePrototype);
770
771  if (tok == MAP_CMD) return GetMapLeftv(link, node, mlv);
772  if (tok == PACKAGE_CMD) return GetPackageLeftv(link, node, mlv);
773  if (tok == COLONCOLON) quote++;
774
775  if (nc > 0)
776  {
777    if (tok == '=') failr(mpsr_GetLeftv(link, mlv, quote + 1));
778    else failr(mpsr_GetLeftv(link, mlv, quote));
779  }
780
781  for (i=1; i<nc; i++)
782  {
783    failr(mpsr_GetLeftv(link, mlv1, quote));
784    failr(mpsr_MergeLeftv(mlv, mlv1));
785  }
786
787  command cmd = (command) omAlloc0Bin(sip_command_bin);
788  cmd->op = tok;
789  cmd->argc = nc;
790
791  // check that associative operators are binary
792  if (nc > 2 && (tok == '+' || tok == '*'))
793  {
794    leftv lv = mlv->lv, lv2;
795    command c = cmd, c2;
796
797    for (i=2; i<nc; i++)
798    {
799      c->op = tok;
800      c->argc = 2;
801      memcpy(&(c->arg1), lv, sizeof(sleftv));
802      c->arg1.next = NULL;
803
804      c2 = (command) omAlloc0Bin(sip_command_bin);
805      c->arg2.data = (void *) c2;
806      c->arg2.rtyp = COMMAND;
807      c = c2;
808      lv2 = lv->next;
809      omFreeBin(lv, sleftv_bin);
810      lv = lv2;
811    }
812    c->op = tok;
813    c->argc = 2;
814    memcpy(&(c->arg1), lv, sizeof(sleftv));
815    c->arg1.next = NULL;
816    memcpy(&(c->arg2), lv->next, sizeof(sleftv));
817    omFreeBin(lv->next, sleftv_bin);
818    omFreeBin(lv, sleftv_bin);
819  }
820  else if (nc >= 1)
821  {
822    memcpy(&(cmd->arg1), mlv->lv, sizeof(sleftv));
823    if (nc <= 3)
824    {
825      (cmd->arg1).next = NULL;
826      if (nc >= 2)
827      {
828        memcpy(&(cmd->arg2), mlv->lv->next, sizeof(sleftv));
829        (cmd->arg2).next = NULL;
830
831        if (nc == 3)
832        {
833          memcpy(&(cmd->arg3), mlv->lv->next->next, sizeof(sleftv));
834          omFreeBin(mlv->lv->next->next, sleftv_bin);
835        }
836        omFreeBin(mlv->lv->next, sleftv_bin);
837      }
838    }
839    omFreeBin(mlv->lv, sleftv_bin);
840  }
841
842  // Now we perform some tree manipulations
843  if (nc == 0 && tok == LIST_CMD)
844    // Here we work around a Singular bug: It can not handle lists of 0 args
845    // so we construct them explicitely
846  {
847    lists l = (lists) omAllocBin(slists_bin);
848    l->Init(0);
849    mlv->lv = mpsr_InitLeftv(LIST_CMD, (void *) l);
850    return mpsr_Success;
851  }
852  mlv->lv = mpsr_InitLeftv(COMMAND, (void *) cmd);
853  return mpsr_Success;
854}
855
856
857/***************************************************************
858 *
859 * The routine for Getting External Data
860 *
861 ***************************************************************/
862
863// this is all the data we want to have in directly when MPT_GetTree
864// is called, i.e. when the value of annots is read
865MPT_Status_t mpsr_GetExternalData(MP_Link_pt link,
866                                  MPT_Arg_t *odata,
867                                  MPT_Node_pt node)
868{
869  *odata = NULL;
870
871  if (node->type == MP_CommonOperatorType)
872  {
873    mpsr_sleftv mlv;
874    mpsr_Status_t status;
875    BOOLEAN IsUnOrdered;
876
877    // we would like to get polys and ideals directly
878    if (IsPolyNode(node, mlv.r, IsUnOrdered))
879      status = GetPolyLeftv(link, node, &mlv, IsUnOrdered);
880    // Ideal
881    else if (IsIdealNode(node, mlv.r, IsUnOrdered))
882      status = GetIdealLeftv(link, node, &mlv, IsUnOrdered);
883    else
884      return MPT_NotExternalData;
885
886    if (status == mpsr_Success)
887    {
888      mpsr_leftv mmlv = (mpsr_leftv) omAlloc0Bin(mpsr_sleftv_bin);
889      memcpy(mmlv, &mlv, sizeof(mpsr_sleftv));
890      *odata = (MPT_ExternalData_t) mmlv;
891      return MPT_Success;
892    }
893    else
894      return MPT_Failure;
895  }
896  else
897    return MPT_NotExternalData;
898}
899
900
901/***************************************************************
902 *
903 * A routine which gets the previous dump of Singular
904 *
905 ***************************************************************/
906
907mpsr_Status_t mpsr_GetDump(MP_Link_pt link)
908{
909  mpsr_sleftv mlv;
910  mpsr_Status_t status = mpsr_Success;
911
912  status = (MP_InitMsg(link) == MP_Success ? mpsr_Success : mpsr_MP_Failure);
913  while ((status == mpsr_Success) && (! MP_TestEofMsg(link)))
914  {
915    memset(&mlv,0,sizeof(mlv));
916    status=mpsr_GetLeftv(link, &mlv, 0);
917
918    if (status == mpsr_Success)
919    {
920#ifdef MPSR_DEBUG_DUMP
921      command cmd = (command) mlv.lv->data;
922      fprintf(stdout, "Dump got %s \n", cmd->arg1.name);
923      fflush(stdout);
924#endif
925      mpsr_SetCurrRingHdl(&mlv);
926      if (mlv.lv != NULL)
927      {
928        mlv.lv->Eval();
929        mlv.lv->CleanUp();
930        omFreeBin(mlv.lv, sleftv_bin);
931      }
932    }
933    else
934      mpsr_PrintError(status);
935  }
936  return status;
937}
938#endif
Note: See TracBrowser for help on using the repository browser.