source: git/Singular/mpsr_Put.cc @ 0e1846

spielwiese
Last change on this file since 0e1846 was 0e1846, checked in by Olaf Bachmann <obachman@…>, 27 years ago
This commit was generated by cvs2svn to compensate for changes in r59, which included commits to RCS files with non-trunk default branches. git-svn-id: file:///usr/local/Singular/svn/trunk@60 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 17.2 KB
Line 
1/***************************************************************
2 *
3 * File:       mpsr_Put.cc
4 * Purpose:    main put routines for MP connection to Singular
5 * Author:     Olaf Bachmann (10/95)
6 *
7 * Change History (most recent first):
8 *  o 1/97 obachman
9 *    Updated putting routines to MP and MPP v1.1
10 *
11 ***************************************************************/
12#include "mod2.h"
13
14#ifdef HAVE_MPSR
15
16#include "mpsr_Put.h"
17#include "mpsr_Tok.h"
18#include "intvec.h"
19#include "lists.h"
20#include "numbers.h"
21#include "polys.h"
22#include "sing_mp.h"
23#include "ring.h"
24
25/***************************************************************
26 *
27 * There are 4 different layers on which things are put:
28 * 1.) Singular Top-level Data (chains of leftv's) == MP message
29 * 2.) Single leftv's
30 * 3.) Plain Singular data (different Singular data types)
31 * 4.) Primitive polynomial Data
32 *
33 ***************************************************************/
34
35/***************************************************************
36 * 1.) Routines for Top-level Data
37 *
38 ***************************************************************/
39// this puts everything it finds in a leftv on the MP-link in form of
40// a message; Each leftv is sent as one MP Tree. The leftvs in a chain
41// of leftv's (i.e. for v->next != NULL) are sent as separate MP Trees
42// within the same MP message
43mpsr_Status_t mpsr_PutMsg(MP_Link_pt l, leftv v)
44{
45  mpsr_Status_t status = mpsr_Success;
46
47  MP_ResetLink(l);
48  while (v != NULL && status == mpsr_Success)
49  {
50    status = mpsr_PutLeftv(l, v, currRing);
51    v = v->next;
52  }
53  MP_EndMsg(l);
54
55  return status;
56}
57
58
59/***************************************************************
60 * Second-level data routines
61 * All the mpsr_Put*Leftv functions are defined as inline's in the header
62 *
63 ***************************************************************/
64
65// This already depends on the ring
66mpsr_Status_t mpsr_PutLeftv(MP_Link_pt link, leftv v, ring cring)
67{
68  idtyp type = v->Typ();
69
70  switch(type)
71  {
72    // first, all the ring-independent types
73      case INT_CMD:
74        return mpsr_PutIntLeftv(link,v);
75
76      case INTVEC_CMD:
77        return mpsr_PutIntVecLeftv(link, v);
78
79      case INTMAT_CMD:
80        return mpsr_PutIntMatLeftv(link, v);
81
82      case STRING_CMD:
83        return mpsr_PutStringLeftv(link, v);
84
85      case RING_CMD:
86        return mpsr_PutRingLeftv(link, v);
87
88      case QRING_CMD:
89        return mpsr_PutQRingLeftv(link, v);
90
91      case PROC_CMD:
92        return mpsr_PutProcLeftv(link, v);
93
94      case DEF_CMD:
95        return mpsr_PutDefLeftv(link, v);
96
97    // now potentially ring-dependent types
98      case LIST_CMD:
99        return mpsr_PutListLeftv(link,v, cring);
100
101      case COMMAND:
102        return mpsr_PutCommandLeftv(link,v, cring);
103
104      case NUMBER_CMD:
105        return mpsr_PutNumberLeftv(link,v, cring);
106
107      case POLY_CMD:
108        return mpsr_PutPolyLeftv(link, v, cring);
109
110      case IDEAL_CMD:
111        return mpsr_PutIdealLeftv(link, v, cring);
112
113      case VECTOR_CMD:
114        return mpsr_PutVectorLeftv(link, v, cring);
115
116      case MODUL_CMD:
117        return mpsr_PutModuleLeftv(link, v, cring);
118
119      case MATRIX_CMD:
120        return mpsr_PutMatrixLeftv(link,v, cring);
121
122      case MAP_CMD:
123        return mpsr_PutMapLeftv(link, v, cring);
124
125      default:
126        return mpsr_SetError(mpsr_UnknownLeftvType);
127  }
128}
129
130/***************************************************************
131 * the Third-level data routines which are ring-independent
132 *
133 ***************************************************************/
134mpsr_Status_t mpsr_PutIntVec(MP_Link_pt link, intvec *iv)
135{
136  int length = iv->length();
137 
138  // Put the Vector Operator
139  mp_failr(MP_PutCommonOperatorPacket(link,
140                                   MP_CopMatrixDenseVector,
141                                   MP_MatrixDict,
142                                   1,
143                                   length));
144  // Prototype Annot
145  mp_failr(MP_PutAnnotationPacket(link,
146                                  MP_AnnotProtoPrototype,
147                                  MP_ProtoDict,
148                                  MP_AnnotReqValNode));
149  // Together with the CommonMetaPacket specifying that each element of
150  // the vector is an Sint32
151  mp_failr(MP_PutCommonMetaPacket(link, MP_CmtProtoSint32,
152                                  MP_ProtoDict, 0));
153 
154  // Now we finally put the data
155  mp_return(IMP_PutSint32Vector(link, (MP_Sint32_t *) iv->ivGetVec(),
156                                length));
157}
158
159mpsr_Status_t mpsr_PutIntMat(MP_Link_pt link, intvec *iv)
160{
161  int r = iv->rows(), c = iv->cols(), length = r*c;
162
163  // First, we put the Matrix operator
164  mp_failr(MP_PutCommonOperatorPacket(link,
165                                   MP_CopMatrixDenseMatrix,
166                                   MP_MatrixDict,
167                                   2,
168                                   length));
169  // Put the two annotations
170  // First, the prototype annot
171  mp_failr(MP_PutAnnotationPacket(link,
172                               MP_AnnotProtoPrototype,
173                               MP_ProtoDict,
174                               MP_AnnotReqValNode));
175  mp_failr(MP_PutCommonMetaPacket(link, MP_CmtProtoSint32, MP_ProtoDict, 0));
176  // And second, the dimension annot
177  mp_failr(MP_PutAnnotationPacket(link,
178                               MP_AnnotMatrixDimension,
179                               MP_MatrixDict,
180                               MP_AnnotReqValNode));
181  // which specifies the dimesnion of the matrix
182  mp_failr(MP_PutCommonOperatorPacket(link,
183                                   MP_CopBasicList,
184                                   MP_BasicDict,
185                                   0, 2));
186  mp_failr(MP_PutUint32Packet(link, (MP_Uint32_t) r, 0));
187  mp_failr(MP_PutUint32Packet(link, (MP_Uint32_t) c, 0));
188
189  // And finally, we put the elments
190  mp_return(IMP_PutSint32Vector(link, (MP_Sint32_t *) iv->ivGetVec(),
191                                length));
192}
193
194mpsr_Status_t mpsr_PutRing(MP_Link_pt link, ring cring)
195{
196  mp_failr(MP_PutCommonOperatorPacket(link,
197                                   MP_CopPolyRing,
198                                   MP_PolyDict,
199                                   mpsr_GetNumOfRingAnnots(cring, 1),
200                                   0));
201  return mpsr_PutRingAnnots(link, cring, 1);
202}
203
204mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, char *proc)
205{
206  MP_DictTag_t dict;
207  MP_Common_t  cop;
208
209  failr(mpsr_tok2mp('=', &dict, &cop));
210 
211  // A Singular- procedure is sent as a cop with the string as arg
212  mp_failr(MP_PutCommonOperatorPacket(link,
213                                   cop,
214                                   dict,
215                                   0,
216                                   2));
217  mp_failr(MP_PutIdentifierPacket(link, pname, MP_BasicDict, 1));
218  mp_failr(MP_PutAnnotationPacket(link, MP_AnnotSingularProcDef,
219                                  MP_SingularDict, 0));
220  mp_return(MP_PutStringPacket(link, proc, 0));
221}
222
223
224/***************************************************************
225 * the Third-level data routines which are ring-dependent
226 *
227 ***************************************************************/
228
229inline mpsr_Status_t PutLeftvChain(MP_Link_pt link, leftv lv, ring r)
230{
231  while (lv != NULL)
232  {
233    failr(mpsr_PutLeftv(link, lv, r));
234    lv = lv->next;
235  }
236  return mpsr_Success;
237}
238
239mpsr_Status_t mpsr_PutList(MP_Link_pt link, lists l, ring cring)
240{
241  int i, nl = l->nr + 1;
242
243  mp_failr(MP_PutCommonOperatorPacket(link,
244                                   MP_CopBasicList,
245                                   MP_BasicDict,
246                                   0,
247                                   nl));
248  for (i=0; i<nl; i++)
249    failr(mpsr_PutLeftv(link, &(l->m[i]), cring));
250
251  return mpsr_Success;
252}
253
254mpsr_Status_t mpsr_PutCopCommand(MP_Link_pt link,  command cmd, ring cring)
255{
256  MP_Common_t cop;
257  MP_DictTag_t dict;
258  MP_NumChild_t nc = cmd->argc;
259  leftv l;
260
261  // First, we get the command cop -- at the moment, everything should be
262  // a MP cop
263  failr(mpsr_tok2mp(cmd->op, &dict, &cop));
264
265  // and put the common operator
266  mp_failr(MP_PutCommonOperatorPacket(link, cop, dict, 0, nc));
267
268  // now we Put the arguments
269  if (nc > 0)
270  {
271    if (nc <= 3)
272    {
273      failr(mpsr_PutLeftv(link, &(cmd->arg1), cring));
274      if (nc >1)
275      {
276        failr(mpsr_PutLeftv(link, &(cmd->arg2), cring));
277        if (nc == 3) return mpsr_PutLeftv(link, &(cmd->arg3), cring);
278        else return mpsr_Success;
279      }
280      else return mpsr_Success;
281    }
282    else
283      return PutLeftvChain(link, &(cmd->arg1), cring);
284  }
285  return mpsr_Success;
286}
287
288mpsr_Status_t mpsr_PutOpCommand(MP_Link_pt link,  command cmd, ring cring)
289{
290  mp_failr(MP_PutOperatorPacket(link,
291                             (char *) (cmd->arg1.Data()),
292                             MP_SingularDict,
293                             0,
294                             (cmd->argc <= 1 ? 0 :(cmd->arg2).listLength())));
295  if (cmd->argc > 1)
296    return PutLeftvChain(link, &(cmd->arg2), cring);
297  else
298    return mpsr_Success;
299}
300
301// Numbers are put as polys with one monomial and all exponents zero
302mpsr_Status_t mpsr_PutNumber(MP_Link_pt link,  number n, ring cring)
303{
304  ring rr = NULL;
305  poly p = NULL;
306  mpsr_Status_t r;
307
308  if (currRing != cring)
309  {
310    rr = currRing;
311    mpsr_SetCurrRing(cring, TRUE);
312  }
313 
314  if (!nIsZero(n))
315  {
316    p = pOne();
317    pSetCoeff(p, nCopy(n));
318  }
319  r = mpsr_PutPoly(link, p, cring);
320  pDelete(&p);
321
322  if (rr != NULL) mpsr_SetCurrRing(rr, TRUE);
323 
324  return r;
325}
326
327mpsr_Status_t mpsr_PutPoly(MP_Link_pt link, poly p, ring cring)
328{
329  mp_failr(MP_PutCommonOperatorPacket(link,
330                                   MP_CopPolyDenseDistPoly,
331                                   MP_PolyDict,
332                                   mpsr_GetNumOfRingAnnots(cring, 0),
333                                   pLength(p)));
334  failr(mpsr_PutRingAnnots(link, cring, 0));
335  return mpsr_PutPolyData(link, p, cring);
336}
337
338
339mpsr_Status_t mpsr_PutPolyVector(MP_Link_pt link, poly p, ring cring)
340{
341  mp_failr(MP_PutCommonOperatorPacket(link,
342                                   MP_CopPolyDenseDistPoly,
343                                   MP_PolyDict,
344                                   mpsr_GetNumOfRingAnnots(cring,1),
345                                   pLength(p)));
346  failr(mpsr_PutRingAnnots(link, cring, 1));
347  return mpsr_PutPolyVectorData(link, p, cring);
348}
349
350
351mpsr_Status_t mpsr_PutIdeal(MP_Link_pt link, ideal id, ring cring)
352{
353  int i, idn = IDELEMS(id);
354
355  mp_failr(MP_PutCommonOperatorPacket(link,
356                                   MP_CopPolyIdeal,
357                                   MP_PolyDict,
358                                   1,
359                                   idn));
360  mp_failr(MP_PutAnnotationPacket(link,
361                               MP_AnnotProtoPrototype,
362                               MP_ProtoDict,
363                               MP_AnnotReqValNode));
364  mp_failr(MP_PutCommonMetaOperatorPacket(link,
365                                       MP_CopPolyDenseDistPoly,
366                                       MP_PolyDict,
367                                       mpsr_GetNumOfRingAnnots(cring, 0),
368                                       0));
369  failr(mpsr_PutRingAnnots(link, cring, 0));
370
371  for (i=0; i < idn; i++)
372  {
373    IMP_PutUint32(link, pLength(id->m[i]));
374    failr(mpsr_PutPolyData(link, id->m[i], cring));
375  }
376  return mpsr_Success;
377}
378
379mpsr_Status_t mpsr_PutModule(MP_Link_pt link, ideal id, ring cring)
380{
381  int i, idn = IDELEMS(id);
382
383  mp_failr(MP_PutCommonOperatorPacket(link,
384                                   MP_CopPolyModule,
385                                   MP_PolyDict,
386                                   1,
387                                   idn));
388  mp_failr(MP_PutAnnotationPacket(link,
389                               MP_AnnotProtoPrototype,
390                               MP_ProtoDict,
391                               MP_AnnotReqValNode));
392  mp_failr(MP_PutCommonMetaOperatorPacket(link,
393                                       MP_CopPolyDenseDistPoly,
394                                       MP_PolyDict,
395                                       mpsr_GetNumOfRingAnnots(cring, 1),
396                                       0));
397  failr(mpsr_PutRingAnnots(link, cring, 1));
398
399  for (i=0; i < idn; i++)
400  {
401    IMP_PutUint32(link, pLength(id->m[i]));
402    failr(mpsr_PutPolyVectorData(link, id->m[i], cring));
403  }
404  return mpsr_Success;
405}
406
407mpsr_Status_t mpsr_PutMatrix(MP_Link_pt link, ideal id, ring cring)
408{
409  int nrows = id->nrows, ncols = id->ncols;
410  MP_Uint32_t n = nrows*ncols, i;
411
412  // First, we put the Matrix operator
413  mp_failr(MP_PutCommonOperatorPacket(link,
414                                   MP_CopMatrixDenseMatrix,
415                                   MP_MatrixDict,
416                                   2,
417                                   n));
418  // Put the two annotations
419  // First, the prototype annot
420  mp_failr(MP_PutAnnotationPacket(link,
421                               MP_AnnotProtoPrototype,
422                               MP_ProtoDict,
423                               MP_AnnotReqValNode));
424  mp_failr(MP_PutCommonMetaOperatorPacket(link,
425                                       MP_CopPolyDenseDistPoly,
426                                       MP_PolyDict,
427                                       mpsr_GetNumOfRingAnnots(cring, 0),
428                                       0));
429  failr(mpsr_PutRingAnnots(link, cring, 0));
430
431  // second, the matrix dim annot
432  mp_failr(MP_PutAnnotationPacket(link,
433                               MP_AnnotMatrixDimension,
434                               MP_MatrixDict,
435                               MP_AnnotReqValNode));
436  // which specifies the dimesnion of the matrix
437  mp_failr(MP_PutCommonOperatorPacket(link,
438                                   MP_CopBasicList,
439                                   MP_BasicDict,
440                                   0, 2));
441  mp_failr(MP_PutUint32Packet(link, (MP_Uint32_t) nrows, 0));
442  mp_failr(MP_PutUint32Packet(link, (MP_Uint32_t) ncols, 0));
443
444  // And finally, we put the elments
445  for (i=0; i < n; i++)
446  {
447    IMP_PutUint32(link, pLength(id->m[i]));
448    failr(mpsr_PutPolyData(link, id->m[i], cring));
449  }
450  return mpsr_Success;
451}
452
453
454// We communicate a map as an operator having three arguments: A ring,
455// its name and an ideal
456mpsr_Status_t mpsr_PutMap(MP_Link_pt link, map m, ring cring)
457{
458  MP_Uint32_t i, idn = IDELEMS((ideal) m);
459  MP_DictTag_t dict;
460  MP_Common_t cop;
461
462  failr(mpsr_tok2mp(MAP_CMD, &dict, &cop));
463
464  mp_failr(MP_PutCommonOperatorPacket(link,
465                                   cop,
466                                   dict,
467                                   0,
468                                   3));
469  // First, is the ring
470  failr(mpsr_PutRingLeftv(link, (leftv) idroot->get(m->preimage, 1)));
471
472  // Second, the name of the ring
473  mp_failr(MP_PutStringPacket(link, m->preimage,0));
474 
475  // and third, the ideal --
476  // supposing that we can cast a map to an ideal
477  return mpsr_PutIdeal(link, (ideal) m, cring);
478}
479
480
481/***************************************************************
482 * 
483 * A routine which dumps the content of Singular to a file
484 *
485 ***************************************************************/
486BOOLEAN mpsr_PutDump(char *fn)
487{
488  MP_Link_pt link = OpenMPFile(fn, 0);
489  BOOLEAN status;
490
491  if (link == NULL) return FALSE;
492  else status = mpsr_PutDump(link);
493
494  MP_CloseLink(link);
495  return status;
496}
497
498
499BOOLEAN mpsr_PutDump(MP_Link_pt link)
500{
501  idhdl h = idroot, h2 = NULL, rh = currRingHdl;
502  ring r;
503  sip_command cmd;
504  leftv lv;
505
506  mpsr_ClearError();
507  memset(&(cmd), 0, sizeof(sip_command));
508  cmd.argc = 2;
509  cmd.op = '=';
510  cmd.arg1.rtyp = DEF_CMD;
511  lv = mpsr_InitLeftv(COMMAND, (void *) &cmd);
512 
513  MP_ResetLink(link);
514  while (h != NULL && h2 == NULL)
515  {
516    if (IDTYP(h) == PROC_CMD)
517    {
518      failr(mpsr_PutLeftv(link, (leftv) h, NULL));
519#ifdef MPSR_DEBUG
520      Print("Dumped Proc %s\n", IDID(h));
521#endif
522    }
523    else
524    {
525      cmd.arg1.name = IDID(h);
526      memcpy(&(cmd.arg2), h, sizeof(sleftv));
527      if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success) break;
528#ifdef MPSR_DEBUG
529      Print("Dumped %s\n", IDID(h));
530#endif
531      if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD)
532      {
533        // we don't really need to do that, it's only for convenience
534        // for putting numbers
535        rSetHdl(h, TRUE);
536        r = IDRING(h);
537        h2 = r->idroot;
538        while (h2 != NULL)
539        {
540          cmd.arg1.name = IDID(h2);
541          memcpy(&(cmd.arg2), h2, sizeof(sleftv));
542          if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
543#ifdef MPSR_DEBUG
544      Print("Dumped %s\n", IDID(h2));
545#endif
546          h2 = h2->next;
547        }
548      }
549    }
550   
551    h = h->next;
552  }
553  MP_EndMsg(link);
554  Free(lv, sizeof(sleftv));
555  if (rh != NULL && rh != currRingHdl) rSetHdl(rh, TRUE);
556 
557  if (h == NULL && h2 == NULL)
558    return TRUE;
559  else
560  {
561    mpsr_PrintError();
562    return FALSE;
563  }
564}
565 
566BOOLEAN mpsr_PutDump(leftv h)
567{
568  if (h == NULL)
569  {
570    Print("Using file %s for dump\n", MPSR_DEFAULT_DUMP_FILE);
571    return mpsr_PutDump(MPSR_DEFAULT_DUMP_FILE);
572  }
573  else if (h->Typ() == STRING_CMD)
574  {
575    return mpsr_PutDump((char *) h->Data());
576  }
577  else if (h->Typ() == LINK_CMD)
578  {
579    si_link l = (si_link) h->Data();
580    if (SI_LINK_W_OPEN_P(l) && mpsr_IsMPLink(l))
581      return mpsr_PutDump((MP_Link_pt) l->data);
582    else
583      Werror("Can only dump data to an already opened MP link");
584  }
585  else
586  {
587    Werror("Need string or opened MP Link");
588  }
589  return FALSE;
590}
591#endif // HAVE_MPSR
592
593
Note: See TracBrowser for help on using the repository browser.