source: git/Singular/mpsr_Put.cc @ b14855

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