source: git/Singular/mpsr_Get.cc @ a9a7be

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