source: git/Singular/mpsr_Get.cc @ 82dbf50

fieker-DuValspielwiese
Last change on this file since 82dbf50 was 82dbf50, checked in by Olaf Bachmann <obachman@…>, 26 years ago
* minor changes git-svn-id: file:///usr/local/Singular/svn/trunk@2675 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 24.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/* $Id: mpsr_Get.cc,v 1.21 1998-11-13 12:20:59 obachman Exp $ */
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 "mod2.h"
17
18#ifdef HAVE_MPSR
19
20
21#include"mpsr_Get.h"
22#include"mpsr_Tok.h"
23
24#include "tok.h"
25#include "longrat.h"
26#include "ring.h"
27#include "intvec.h"
28#include "ideals.h"
29#include "matpol.h"
30#include "lists.h"
31#include "sing_mp.h"
32
33#include <limits.h>
34
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
74inline 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
83inline 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
92inline 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) == MP_Success;
98}
99
100inline 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) == MP_Success;
109}
110
111inline 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) == MP_Success;
121}
122
123inline 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
136inline 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
148inline 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
160inline BOOLEAN IsQuitNode(MPT_Node_pt node)
161{
162  return NodeCheck(node, MP_MpDict, MP_CopMpEndSession);
163}
164
165//
166// Init*Leftv functions
167//
168inline void InitIntLeftv(mpsr_leftv mlv, int i)
169{
170  mlv->lv = mpsr_InitLeftv(INT_CMD, (void *) i);
171}
172
173inline void InitApIntLeftv(mpsr_leftv mlv, mpz_ptr apint)
174{
175  number n = (number) Alloc(sizeof(rnumber));
176#ifdef LDEBUG
177    n->debug=123456;
178#endif
179  mlv->r = mpsr_rDefault(0);
180  n->s = 3;
181  memcpy(&(n->z), apint, sizeof(MP_INT));
182  n = nlInit(n);
183  Free(apint, sizeof(MP_INT));
184  mlv->lv = mpsr_InitLeftv(NUMBER_CMD, n);
185}
186
187inline 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 
196inline 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
209    {
210      poly p;
211     
212      pos = mpsr_rDefault(0, name, mlv->r);
213      mpsr_SetCurrRing(mlv->r, TRUE);
214      p = pOne();
215      pSetExp(p,pos+1, 1);
216      pSetm(p);
217      mlv->lv = mpsr_InitLeftv(POLY_CMD, (void *) p);
218    }
219    FreeL(name);
220  }
221  else
222  {
223    mlv->lv = mpsr_InitLeftv(DEF_CMD, NULL);
224    mlv->lv->name = name;
225  }
226}
227
228/* primitive mpsr_Get*Leftv functions */
229
230inline mpsr_Status_t mpsr_GetIntLeftv(MPT_Node_pt node, mpsr_leftv mlv)
231{
232  mpsr_assume(MP_IsFixedIntegerType(node->type));
233  mlv->lv = mpsr_InitLeftv(INT_CMD, node->nvalue);
234  return mpsr_Success;
235}
236
237inline mpsr_Status_t mpsr_GetReal32Leftv(MPT_Node_pt node, mpsr_leftv mlv) 
238{
239  mpsr_assume(node->type == MP_Real32Type);
240  InitReal32Leftv(mlv, node->nvalue);
241  return mpsr_Success;
242}
243
244inline mpsr_Status_t mpsr_GetApIntLeftv(MPT_Node_pt node, mpsr_leftv mlv)
245{
246  InitApIntLeftv(mlv, (mpz_ptr)  node->nvalue);
247  node->nvalue = NULL;
248  return mpsr_Success;
249}
250
251inline mpsr_Status_t mpsr_GetIdentifierLeftv(MPT_Node_pt node, mpsr_leftv mlv,
252                                             short quote)
253{
254  mpsr_assume(MP_IsIdType(node->type));
255  char *id;
256  MPT_Annot_pt proc_annot = MPT_Annot(node, MP_SingularDict,
257                                          MP_AnnotSingularProcDef);
258
259  if (node->type == MP_CommonGreekIdentifierType ||
260      node->type == MP_CommonGreekIdentifierType)
261  {
262    id  = (char *) AllocL(2*sizeof(char));
263    id[1] = '\0';
264    id[0] = MP_UINT8_T(node->nvalue);
265  }
266  else
267  {
268    id = MP_STRING_T(node->nvalue);
269    node->nvalue = NULL;
270  }
271 
272  InitIdentifierLeftv(mlv, id, quote);
273
274  if (proc_annot != NULL) mlv->lv->rtyp = PROC_CMD;
275   
276  return mpsr_Success;
277}
278
279inline mpsr_Status_t mpsr_GetStringLeftv(MPT_Node_pt node, mpsr_leftv mlv)
280{
281  mpsr_assume(node->type == MP_StringType);
282  mlv->lv = mpsr_InitLeftv(STRING_CMD, MP_STRING_T(node->nvalue));
283  node->nvalue = NULL;
284  return mpsr_Success;
285}
286
287inline mpsr_Status_t GetQuitLeftv(mpsr_leftv mlv)
288{
289  mlv->lv = mpsr_InitLeftv(STRING_CMD, (void *) mstrdup(MPSR_QUIT_STRING));
290  return mpsr_Success;
291}
292
293/***************************************************************
294 *
295 * The top-level routine for getting a message
296 *
297 ***************************************************************/
298mpsr_Status_t mpsr_GetMsg(MP_Link_pt link, leftv &lv)
299{
300  mpsr_sleftv mlv, mlv1;
301  mpsr_Status_t status = mpsr_Success;
302  mlv.lv = NULL;
303  mlv.r = NULL;
304  mlv1.lv = NULL;
305  mlv1.r = NULL;
306
307  status = (MP_InitMsg(link) == MP_Success ? mpsr_Success : mpsr_MP_Failure);
308 
309  if (status == mpsr_Success && ! MP_TestEofMsg(link))
310    status = mpsr_GetLeftv(link, &mlv, 0);
311  else
312  {
313    lv = mpsr_InitLeftv(NONE, NULL);
314    return status;
315  }
316
317  // handle more than one leftv (ie. chains of leftv's)
318  while (status == mpsr_Success && ! MP_TestEofMsg(link))
319  {
320    // Get next leftv
321    status = mpsr_GetLeftv(link, &mlv1, 0);
322    if (status == mpsr_Success)
323      status = mpsr_MergeLeftv(&mlv, &mlv1);
324  }
325
326  if (status == mpsr_Success)
327  {
328    // Now mlv is our leftv -- check whether r has an ordering set
329    if (mlv.r != NULL && mlv.r->order[0] == ringorder_unspec)
330    { 
331        ring r = rCopy(mlv.r);
332        r->order[0] = ringorder_dp;
333        mpsr_rSetOrdSgn(r);
334        mpsr_MapLeftv(mlv.lv, mlv.r, r);
335        rKill(mlv.r);
336        mlv.r = r;
337    }
338     
339    mpsr_SetCurrRingHdl(mlv.r);
340
341    lv = mlv.lv;
342  }
343  else lv = mpsr_InitLeftv(NONE, NULL); 
344 
345  return status;
346}
347
348/***************************************************************
349 *
350 * Top-level routine for getting a mpsr_leftv
351 *
352 ***************************************************************/
353
354// if quote > 0, then identifiers are not tried to be resolved, or
355// converted into a ring variable
356mpsr_Status_t mpsr_GetLeftv(MP_Link_pt link, mpsr_leftv mlv, short quote)
357{
358  MPT_Node_pt node = NULL;
359  MP_NodeType_t type;
360  mlv->r = NULL;
361  mlv->lv = NULL;
362
363  mpt_failr(MPT_GetNode(link, &node));
364
365  type = node->type;
366
367  if (MP_IsFixedIntegerType(type))
368    failr(mpsr_GetIntLeftv(node, mlv));
369  else if (MP_IsIdType(type))
370    failr(mpsr_GetIdentifierLeftv(node, mlv, quote));
371  else
372  {
373    switch (node->type)
374    {
375        case MP_ApIntType:
376          failr(mpsr_GetApIntLeftv(node, mlv));
377          break;       
378
379        case MP_StringType:
380          failr(mpsr_GetStringLeftv(node, mlv));
381          break;       
382
383        case MP_Real32Type:
384          failr(mpsr_GetReal32Leftv(node, mlv));
385          break;       
386       
387        case MP_CommonOperatorType:
388          failr(mpsr_GetCommonOperatorLeftv(link, node, mlv, quote));
389          break;       
390
391        case MP_OperatorType:
392          failr(mpsr_GetOperatorLeftv(link, node, mlv, quote));
393          break;       
394
395        default:
396          MPT_DeleteNode(node);
397          return mpsr_SetError(mpsr_UnknownMPNodeType);
398    }
399  }
400 
401  // everything was ok
402  MPT_DeleteNode(node);
403  return mpsr_Success;
404}
405
406/***************************************************************
407 *
408 * mpsr_Get*Leftv
409 *
410 ***************************************************************/
411mpsr_Status_t mpsr_GetCommonOperatorLeftv(MP_Link_pt link,
412                                          MPT_Node_pt node,
413                                          mpsr_leftv mlv,
414                                          short quote)
415{
416  mpsr_assume(node->type == MP_CommonOperatorType);
417  BOOLEAN IsUnOrdered;
418 
419  // Check for Singular data types
420  // IntVec
421  if (IsIntVecNode(node))
422    return GetIntVecLeftv(link, node, mlv);
423  // IntMat
424  else if (IsIntMatNode(node))
425    return GetIntMatLeftv(link, node, mlv);
426  // Ring
427  else if (IsRingNode(node, mlv->r, IsUnOrdered))
428    return GetRingLeftv(link, node, mlv);
429  // Poly
430  else if (IsPolyNode(node, mlv->r, IsUnOrdered))
431    return GetPolyLeftv(link, node, mlv, IsUnOrdered);
432  // PolyVector
433  else if (IsPolyVectorNode(node, mlv->r, IsUnOrdered))
434    return GetPolyVectorLeftv(link, node, mlv, IsUnOrdered);
435  // Ideal
436  else if (IsIdealNode(node, mlv->r, IsUnOrdered))
437    return GetIdealLeftv(link, node, mlv, IsUnOrdered);
438  // Module
439  else if (IsModuleNode(node, mlv->r, IsUnOrdered))
440    return GetModuleLeftv(link, node, mlv, IsUnOrdered);
441  // Matrix
442  else if (IsMatrixNode(node, mlv->r, IsUnOrdered))
443    return GetMatrixLeftv(link, node, mlv, IsUnOrdered);
444  else if (IsQuitNode(node))
445    return GetQuitLeftv(mlv);
446  // Map
447  else
448    // now it should be a command (which handles Proc, Map and List
449    // seperately)
450    return GetCopCommandLeftv(link, node, mlv, quote);
451}
452
453mpsr_Status_t mpsr_GetOperatorLeftv(MP_Link_pt link,
454                                  MPT_Node_pt node,
455                                  mpsr_leftv mlv,
456                                  short quote)
457{
458  mpsr_assume(node->type == MP_OperatorType);
459  MP_NumChild_t nc = node->numchild, i;
460  mpsr_sleftv smlv1, *mlv1 = &smlv1;
461 
462
463  if (MPT_ProtoAnnotValue(node) != NULL)
464    return mpsr_SetError(mpsr_CanNotHandlePrototype);
465
466  if (nc > 0)
467  {
468    failr(mpsr_GetLeftv(link, mlv, quote));
469    for (i=1; i<nc; i++)
470    {
471      failr(mpsr_GetLeftv(link, mlv1, quote));
472      failr(mpsr_MergeLeftv(mlv, mlv1));
473    }
474  }
475 
476  command cmd = (command) Alloc0(sizeof(sip_command));
477  cmd->op = PROC_CMD;
478  cmd->arg1.rtyp = STRING_CMD;
479  cmd->arg1.data = (void *) mstrdup(MP_STRING_T(node->nvalue));
480
481  if (node->numchild > 0)
482  {
483    cmd->argc = 2;
484    memcpy(&(cmd->arg2), mlv->lv, sizeof(sleftv));
485    Free(mlv->lv, sizeof(sleftv));
486  }
487  else cmd->argc = 1;
488
489  mlv->lv = mpsr_InitLeftv(COMMAND, (void *) cmd);
490  return mpsr_Success;
491}
492 
493/***************************************************************
494 *
495 * Get*Leftv routines
496 *
497 ***************************************************************/
498//
499// Get*Leftv routines
500//
501static mpsr_Status_t GetIntVecLeftv(MP_Link_pt link, MPT_Node_pt node,
502                                  mpsr_leftv mlv)
503{
504  intvec *iv = new intvec(node->numchild);
505  int *v = iv->ivGetVec();
506
507  mp_failr(IMP_GetSint32Vector(link, &v, node->numchild));
508  mlv->lv = mpsr_InitLeftv(INTVEC_CMD, (void *) iv);
509  return mpsr_Success;
510}
511
512static mpsr_Status_t GetIntMatLeftv(MP_Link_pt link, MPT_Node_pt node,
513                                  mpsr_leftv mlv)
514{
515  intvec *iv;
516  int row = node->numchild, col = 1, *v;
517  MPT_Annot_pt annot = MPT_Annot(node, MP_MatrixDict,
518                                     MP_AnnotMatrixDimension);
519  if (annot != NULL &&
520      annot->value != NULL &&
521      annot->value->node->numchild == 2 &&
522      NodeCheck(annot->value->node, MP_CommonOperatorType, MP_BasicDict,
523                MP_CopBasicList))
524  {
525    MPT_Tree_pt *tarray = (MPT_Tree_pt *) annot->value->args;
526    if (tarray[0]->node->type == MP_Sint32Type &&
527        tarray[1]->node->type == MP_Sint32Type)
528    {
529      row = MP_SINT32_T(tarray[0]->node->nvalue);
530      col = MP_SINT32_T(tarray[1]->node->nvalue);
531    }
532  }
533
534  iv = new intvec(row, col, 0);
535  v = iv->ivGetVec();
536  mp_failr(IMP_GetSint32Vector(link, &v, node->numchild));
537  mlv->lv = mpsr_InitLeftv(INTMAT_CMD, (void *) iv);
538  return mpsr_Success;
539} 
540
541static mpsr_Status_t GetRingLeftv(MP_Link_pt link, MPT_Node_pt node,
542                                mpsr_leftv mlv)
543{
544  mpsr_assume(mlv->r != NULL);
545
546  if (node->numchild != 0) mpt_failr(MPT_SkipArgs(link, node));
547
548  mlv->lv = mpsr_InitLeftv(((mlv->r->qideal != NULL) ? (short) QRING_CMD :
549                            (short) RING_CMD),
550                           (void *) mlv->r);
551  mlv->r = NULL;
552  return mpsr_Success;
553}
554
555static mpsr_Status_t GetPolyLeftv(MP_Link_pt link, MPT_Node_pt node,
556                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered)
557{
558  poly p;
559
560  mpsr_assume(mlv->r != NULL);
561 
562  failr(mpsr_GetPoly(link, p, node->numchild, mlv->r));
563  if (IsUnOrdered) p = pOrdPolyMerge(p);
564  pTest(p);
565  mlv->lv = mpsr_InitLeftv(POLY_CMD, (void *) p);
566  return mpsr_Success;
567}
568
569static mpsr_Status_t GetPolyVectorLeftv(MP_Link_pt link, MPT_Node_pt node,
570                                      mpsr_leftv mlv, BOOLEAN IsUnOrdered)
571{
572  poly p;
573
574  mpsr_assume(mlv->r != NULL);
575 
576  failr(mpsr_GetPolyVector(link, p, node->numchild, mlv->r));
577  if (IsUnOrdered) p = pOrdPolyMerge(p);
578  pTest(p);
579  mlv->lv = mpsr_InitLeftv(VECTOR_CMD, (void *) p);
580  return mpsr_Success;
581}
582
583static mpsr_Status_t GetIdealLeftv(MP_Link_pt link, MPT_Node_pt node,
584                                 mpsr_leftv mlv, BOOLEAN IsUnOrdered)
585{
586  MP_NumChild_t nc = node->numchild, i;
587  ring r = mlv->r;
588  MP_Uint32_t nmon;
589
590  mpsr_assume(r != NULL);
591  ideal id = idInit(nc,1);
592  for (i=0; i<nc; i++)
593  {
594    mp_failr(IMP_GetUint32(link, &nmon));
595    failr(mpsr_GetPoly(link, id->m[i], nmon, r));
596    if (IsUnOrdered) id->m[i] = pOrdPolyMerge(id->m[i]);
597  }
598  idTest(id);
599  mlv->lv = mpsr_InitLeftv(IDEAL_CMD, (void *) id);
600  return mpsr_Success;
601}
602
603static mpsr_Status_t GetModuleLeftv(MP_Link_pt link, MPT_Node_pt node,
604                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered)
605{
606  MP_NumChild_t nc = node->numchild, i;
607  ring r = mlv->r;
608  MP_Uint32_t nmon, rank = 1;
609  MPT_Annot_pt annot = MPT_Annot(node, MP_PolyDict,
610                                     MP_AnnotPolyModuleRank);
611  if (annot != NULL && 
612      annot->value != NULL &&
613      annot->value->node->type == MP_Uint32Type
614      )
615    rank = MP_UINT32_T(annot->value->node->nvalue);
616
617  mpsr_assume(r != NULL);
618  ideal id = idInit(nc,rank);
619  for (i=0; i<nc; i++)
620  {
621    mp_failr(IMP_GetUint32(link, &nmon));
622    failr(mpsr_GetPolyVector(link, id->m[i], nmon, r));
623    if (IsUnOrdered) id->m[i] = pOrdPolyMerge(id->m[i]);
624  }
625  if (rank == 1)
626    id->rank = idRankFreeModule(id);
627  idTest(id);
628  mlv->lv = mpsr_InitLeftv(MODUL_CMD, (void *) id);
629  return mpsr_Success;
630}
631
632static mpsr_Status_t GetMatrixLeftv(MP_Link_pt link, MPT_Node_pt node,
633                                  mpsr_leftv mlv, BOOLEAN IsUnOrdered)
634{
635  MP_NumChild_t nc = node->numchild, row = nc, col = 1, i;
636  matrix mp;
637  MP_Uint32_t nmon;
638  MPT_Annot_pt annot = MPT_Annot(node, MP_MatrixDict,
639                                     MP_AnnotMatrixDimension);
640  if (annot != NULL &&
641      annot->value != NULL &&
642      annot->value->node->numchild == 2 &&
643      NodeCheck(annot->value->node, MP_CommonOperatorType, MP_BasicDict,
644               MP_CopBasicList))
645  {
646    MPT_Tree_pt *tarray = (MPT_Tree_pt *) annot->value->args;
647    if (tarray[0]->node->type == MP_Sint32Type &&
648        tarray[1]->node->type == MP_Sint32Type)
649    {
650      row = MP_SINT32_T(tarray[0]->node->nvalue);
651      col = MP_SINT32_T(tarray[1]->node->nvalue);
652    }
653  }
654
655  mpsr_assume(mlv->r != NULL);
656  mp = mpNew(row, col);
657  for (i=0; i<nc; i++)
658  {
659    mp_failr(IMP_GetUint32(link, &nmon));
660    failr(mpsr_GetPoly(link, mp->m[i], nmon, mlv->r));
661    if (IsUnOrdered) mp->m[i] = pOrdPolyMerge(mp->m[i]);
662  }
663
664  mlv->lv = mpsr_InitLeftv(MATRIX_CMD, (void *) mp);
665  return mpsr_Success;
666}
667
668static mpsr_Status_t GetMapLeftv(MP_Link_pt link, MPT_Node_pt node,
669                               mpsr_leftv mlv)
670{
671  mpsr_sleftv smlv1, smlv2, *mlv1 = &smlv1, *mlv2 = &smlv2;
672
673  if (node->numchild != 3)
674    return mpsr_SetError(mpsr_WrongNumofArgs);
675 
676  failr(mpsr_GetLeftv(link, mlv, 0));
677  failr(mpsr_GetLeftv(link, mlv1, 0));
678  failr(mpsr_GetLeftv(link, mlv2, 0));
679
680  if (mlv->lv->rtyp != RING_CMD ||
681      mlv1->lv->rtyp != STRING_CMD ||
682      mlv2->lv->rtyp != IDEAL_CMD)
683    return mpsr_SetError(mpsr_WrongArgumentType);
684
685  ring r = (ring) mlv->lv->data, r2;
686  char *name = (char *) mlv1->lv->data;
687  ideal id = (ideal) mlv2->lv->data;
688
689  idhdl h = mpsr_FindIdhdl(name, r2);
690  if (h == NULL || IDTYP(h) != RING_CMD || ! mpsr_RingEqual(IDRING(h), r))
691  {
692    h = mpsr_InitIdhdl(RING_CMD, r, name);
693    h->next = IDROOT;
694    IDROOT = h;
695  }
696
697  map m = (map) Alloc0(sizeof(sip_smap));
698  m->preimage = mstrdup(name);
699  m->m = id->m;
700  m->nrows = id->nrows;
701  m->ncols = id->ncols;
702
703  Free(mlv->lv, sizeof(sleftv));
704
705  FreeL(mlv1->lv->data);
706  Free(mlv1->lv, sizeof(sleftv));
707 
708  Free(id, sizeof(sip_sideal));
709  Free(mlv2->lv, sizeof(sleftv));
710
711  mlv->r = mlv2->r;
712  mlv->lv = mpsr_InitLeftv(MAP_CMD, (void *) m);
713
714  return mpsr_Success;
715}
716
717 
718static mpsr_Status_t GetCopCommandLeftv(MP_Link_pt link, MPT_Node_pt node,
719                                        mpsr_leftv mlv, short quote)
720{
721  short tok;
722  MP_NumChild_t nc = node->numchild, i;
723  mpsr_sleftv smlv1, *mlv1 = &smlv1;
724  MPT_Tree_pt typespec;
725 
726 
727  failr(mpsr_mp2tok(node->dict, MP_COMMON_T(node->nvalue), &tok));
728
729  if ((typespec = MPT_ProtoAnnotValue(node)) &&
730      MPT_IsTrueProtoTypeSpec(typespec))
731    return mpsr_SetError(mpsr_CanNotHandlePrototype);
732
733  if (tok == MAP_CMD) return GetMapLeftv(link, node, mlv);
734 
735  if (nc > 0)
736  {
737    if (tok == '=') failr(mpsr_GetLeftv(link, mlv, quote + 1));
738    else failr(mpsr_GetLeftv(link, mlv, quote));
739  }
740
741  for (i=1; i<nc; i++)
742  {
743    failr(mpsr_GetLeftv(link, mlv1, quote));
744    failr(mpsr_MergeLeftv(mlv, mlv1));
745  }
746
747  command cmd = (command) Alloc0(sizeof(sip_command));
748  cmd->op = tok;
749  cmd->argc = nc;
750
751  // check that associative operators are binary
752  if (nc > 2 && (tok == '+' || tok == '*'))
753  {
754    leftv lv = mlv->lv, lv2;
755    command c = cmd, c2;
756
757    for (i=2; i<nc; i++)
758    {
759      c->op = tok;
760      c->argc = 2;
761      memcpy(&(c->arg1), lv, sizeof(sleftv));
762      c->arg1.next = NULL;
763
764      c2 = (command) Alloc0(sizeof(sip_command));
765      c->arg2.data = (void *) c2;
766      c->arg2.rtyp = COMMAND;
767      c = c2;
768      lv2 = lv->next;
769      Free(lv, sizeof(sleftv));
770      lv = lv2;
771    }
772    c->op = tok;
773    c->argc = 2;
774    memcpy(&(c->arg1), lv, sizeof(sleftv));
775    c->arg1.next = NULL;
776    memcpy(&(c->arg2), lv->next, sizeof(sleftv));
777    Free(lv->next, sizeof(sleftv));
778    Free(lv, sizeof(sleftv));
779  }
780  else if (nc >= 1)
781  {
782    memcpy(&(cmd->arg1), mlv->lv, sizeof(sleftv));
783    if (nc <= 3)
784    {
785      (cmd->arg1).next = NULL;
786      if (nc >= 2)
787      {
788        memcpy(&(cmd->arg2), mlv->lv->next, sizeof(sleftv));
789        (cmd->arg2).next = NULL;
790
791        if (nc == 3)
792        {
793          memcpy(&(cmd->arg3), mlv->lv->next->next, sizeof(sleftv));
794          Free(mlv->lv->next->next, sizeof(sleftv));
795        }
796        Free(mlv->lv->next, sizeof(sleftv));
797      }
798    }
799    Free(mlv->lv, sizeof(sleftv));
800  }
801
802  // Now we perform some tree manipulations
803  if (nc == 0 && tok == LIST_CMD)
804    // Here we work around a Singular bug: It can not handle lists of 0 args
805    // so we construct them explicitely
806  {
807    lists l = (lists) Alloc(sizeof(slists));
808    l->Init(0);
809    mlv->lv = mpsr_InitLeftv(LIST_CMD, (void *) l);
810    return mpsr_Success;
811  }
812  mlv->lv = mpsr_InitLeftv(COMMAND, (void *) cmd);
813  return mpsr_Success;
814}
815
816 
817/***************************************************************
818 *
819 * The routine for Getting External Data
820 *
821 ***************************************************************/
822
823// this is all the data we want to have in directly when MPT_GetTree
824// is called, i.e. when the value of annots is read
825MPT_Status_t mpsr_GetExternalData(MP_Link_pt link,
826                                  MPT_Arg_t *odata,
827                                  MPT_Node_pt node)
828{
829  *odata = NULL;
830 
831  if (node->type == MP_CommonOperatorType)
832  {
833    mpsr_sleftv mlv;
834    mpsr_Status_t status;
835    BOOLEAN IsUnOrdered;
836
837    // we would like to get polys and ideals directly
838    if (IsPolyNode(node, mlv.r, IsUnOrdered))
839      status = GetPolyLeftv(link, node, &mlv, IsUnOrdered);
840    // Ideal
841    else if (IsIdealNode(node, mlv.r, IsUnOrdered))
842      status = GetIdealLeftv(link, node, &mlv, IsUnOrdered);
843    else
844      return MPT_NotExternalData;
845
846    if (status == mpsr_Success)
847    {
848      mpsr_leftv mmlv = (mpsr_leftv) Alloc0(sizeof(mpsr_sleftv));
849      memcpy(mmlv, &mlv, sizeof(mpsr_sleftv));
850      *odata = (MPT_ExternalData_t) mmlv;
851      return MPT_Success;
852    }
853    else
854      return MPT_Failure;
855  }
856  else
857    return MPT_NotExternalData;
858}
859
860   
861/***************************************************************
862 * 
863 * A routine which gets the previous dump of Singular
864 *
865 ***************************************************************/
866
867mpsr_Status_t mpsr_GetDump(MP_Link_pt link)
868{
869  mpsr_sleftv mlv;
870  mpsr_Status_t status = mpsr_Success;
871
872  status = (MP_InitMsg(link) == MP_Success ? mpsr_Success : mpsr_MP_Failure);
873  while ((status == mpsr_Success) && (! MP_TestEofMsg(link)))
874  {
875    status=mpsr_GetLeftv(link, &mlv, 0);
876
877    if (status == mpsr_Success)
878    {
879#ifdef MPSR_DEBUG
880      command cmd = (command) mlv.lv->data;
881      fprintf(stdout, "Dump got %s \n", cmd->arg1.name);
882      fflush(stdout);
883#endif     
884      mpsr_SetCurrRingHdl(mlv.r);
885      if (mlv.lv != NULL)
886      {
887        mlv.lv->Eval();
888        mlv.lv->CleanUp();
889        Free(mlv.lv, sizeof(sleftv));
890      }
891    }
892    else
893      mpsr_PrintError(status);
894  }
895  return status;
896}
897#endif
Note: See TracBrowser for help on using the repository browser.