source: git/Singular/mpsr_Put.cc @ 97454d

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