source: git/Singular/mpsr_Put.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: 19.3 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: mpsr_Put.cc,v 1.14 1998-11-13 12:20:59 obachman Exp $ */
5
6#define KAI
7
8/***************************************************************
9 *
10 * File:       mpsr_Put.cc
11 * Purpose:    main put routines for MP connection to Singular
12 * Author:     Olaf Bachmann (10/95)
13 *
14 * Change History (most recent first):
15 *  o 1/97 obachman
16 *    Updated putting routines to MP and MPP v1.1
17 *
18 ***************************************************************/
19#include "mod2.h"
20
21#ifdef HAVE_MPSR
22
23#include "mpsr_Put.h"
24#include "mpsr_Tok.h"
25#include "intvec.h"
26#include "lists.h"
27#include "numbers.h"
28#include "polys.h"
29#include "sing_mp.h"
30#include "ring.h"
31
32/***************************************************************
33 *
34 * There are 4 different layers on which things are put:
35 * 1.) Singular Top-level Data (chains of leftv's) == MP message
36 * 2.) Single leftv's
37 * 3.) Plain Singular data (different Singular data types)
38 * 4.) Primitive polynomial Data
39 *
40 ***************************************************************/
41
42/***************************************************************
43 * 1.) Routines for Top-level Data
44 *
45 ***************************************************************/
46// this puts everything it finds in a leftv on the MP-link in form of
47// a message; Each leftv is sent as one MP Tree. The leftvs in a chain
48// of leftv's (i.e. for v->next != NULL) are sent as separate MP Trees
49// within the same MP message
50mpsr_Status_t mpsr_PutMsg(MP_Link_pt l, leftv v)
51{
52  mpsr_Status_t status = mpsr_Success;
53
54  MP_ResetLink(l);
55  while (v != NULL && status == mpsr_Success)
56  {
57    status = mpsr_PutLeftv(l, v, currRing);
58    v = v->next;
59  }
60  MP_EndMsg(l);
61
62  return status;
63}
64
65
66/***************************************************************
67 * Second-level data routines
68 * All the mpsr_Put*Leftv functions are defined as inline's in the header
69 *
70 ***************************************************************/
71
72// This already depends on the ring
73mpsr_Status_t mpsr_PutLeftv(MP_Link_pt link, leftv v, ring cring)
74{
75  idtyp type = v->Typ();
76
77  switch(type)
78  {
79    // first, all the ring-independent types
80      case INT_CMD:
81        return mpsr_PutIntLeftv(link,v);
82
83      case INTVEC_CMD:
84        return mpsr_PutIntVecLeftv(link, v);
85
86      case INTMAT_CMD:
87        return mpsr_PutIntMatLeftv(link, v);
88
89      case STRING_CMD:
90        return mpsr_PutStringLeftv(link, v);
91
92      case RING_CMD:
93        return mpsr_PutRingLeftv(link, v);
94
95      case QRING_CMD:
96        return mpsr_PutQRingLeftv(link, v);
97
98      case PROC_CMD:
99        return mpsr_PutProcLeftv(link, v);
100
101      case DEF_CMD:
102        return mpsr_PutDefLeftv(link, v);
103
104        // now potentially ring-dependent types
105      case LIST_CMD:
106        return mpsr_PutListLeftv(link,v, cring);
107
108      case COMMAND:
109        return mpsr_PutCommandLeftv(link,v, cring);
110
111      case NUMBER_CMD:
112        return mpsr_PutNumberLeftv(link,v, cring);
113
114      case POLY_CMD:
115        return mpsr_PutPolyLeftv(link, v, cring);
116
117      case IDEAL_CMD:
118        return mpsr_PutIdealLeftv(link, v, cring);
119
120      case VECTOR_CMD:
121        return mpsr_PutVectorLeftv(link, v, cring);
122
123      case MODUL_CMD:
124        return mpsr_PutModuleLeftv(link, v, cring);
125
126      case MATRIX_CMD:
127        return mpsr_PutMatrixLeftv(link,v, cring);
128
129      case MAP_CMD:
130        return mpsr_PutMapLeftv(link, v, cring);
131
132      case PACKAGE_CMD:
133        return mpsr_PutPackageLeftv(link, v);
134
135      case NONE:
136        return mpsr_Success;
137
138      default:
139        return mpsr_SetError(mpsr_UnknownLeftvType);
140  }
141}
142
143/***************************************************************
144 * the Third-level data routines which are ring-independent
145 *
146 ***************************************************************/
147mpsr_Status_t mpsr_PutIntVec(MP_Link_pt link, intvec *iv)
148{
149  int length = iv->length();
150
151  // Put the Vector Operator
152  mp_failr(MP_PutCommonOperatorPacket(link,
153                                      MP_MatrixDict,
154                                      MP_CopMatrixDenseVector,
155                                      1,
156                                      length));
157  // Prototype Annot
158  mp_failr(MP_PutAnnotationPacket(link,
159                                  MP_ProtoDict,
160                                  MP_AnnotProtoPrototype,
161                                  MP_AnnotReqValNode));
162  // Together with the CommonMetaTypePacket specifying that each element of
163  // the vector is an Sint32
164  mp_failr(MP_PutCommonMetaTypePacket(link,
165                                      MP_ProtoDict,
166                                      MP_CmtProtoIMP_Sint32,
167                                      0));
168
169  // Now we finally put the data
170  mp_return(IMP_PutSint32Vector(link, (MP_Sint32_t *) iv->ivGetVec(),
171                                length));
172}
173
174mpsr_Status_t mpsr_PutIntMat(MP_Link_pt link, intvec *iv)
175{
176  int r = iv->rows(), c = iv->cols(), length = r*c;
177
178  // First, we put the Matrix operator
179  mp_failr(MP_PutCommonOperatorPacket(link,
180                                      MP_MatrixDict,
181                                      MP_CopMatrixDenseMatrix,
182                                      2,
183                                      length));
184  // Put the two annotations
185  // First, the prototype annot
186  mp_failr(MP_PutAnnotationPacket(link,
187                                  MP_ProtoDict,
188                                  MP_AnnotProtoPrototype,
189                                  MP_AnnotReqValNode));
190  mp_failr(MP_PutCommonMetaTypePacket(link,
191                                  MP_ProtoDict,
192                                  MP_CmtProtoIMP_Sint32,
193                                  0));
194  // And second, the dimension annot
195  mp_failr(MP_PutAnnotationPacket(link,
196                                  MP_MatrixDict,
197                                  MP_AnnotMatrixDimension,
198                                  MP_AnnotReqValNode));
199  // which specifies the dimesnion of the matrix
200  mp_failr(MP_PutCommonOperatorPacket(link,
201                                      MP_BasicDict,
202                                      MP_CopBasicList,
203                                      0,
204                                      2));
205  mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) r, 0));
206  mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) c, 0));
207
208  // And finally, we put the elments
209  mp_return(IMP_PutSint32Vector(link, (MP_Sint32_t *) iv->ivGetVec(),
210                                length));
211}
212
213mpsr_Status_t mpsr_PutRing(MP_Link_pt link, ring cring)
214{
215  mp_failr(MP_PutCommonOperatorPacket(link,
216                                      MP_PolyDict,
217                                      MP_CopPolyRing,
218                                      mpsr_GetNumOfRingAnnots(cring, 1),
219                                      0));
220  return mpsr_PutRingAnnots(link, cring, 1);
221}
222
223mpsr_Status_t mpsr_PutProc(MP_Link_pt link, char* pname, procinfov proc)
224{
225  MP_DictTag_t dict;
226  MP_Common_t  cop;
227  char *iiGetLibProcBuffer(procinfov pi, int part=1);
228
229  failr(mpsr_tok2mp('=', &dict, &cop));
230
231  // A Singular- procedure is sent as a cop with the string as arg
232  mp_failr(MP_PutCommonOperatorPacket(link,
233                                        dict,
234                                        cop,
235                                        0,
236                                        2));
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
258inline 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#ifdef HAVE_NAMESPACES
506  failr(mpsr_PutRingLeftv(link, (leftv) namespaceroot->get(m->preimage, 1)));
507#else /* HAVE_NAMESPACES */
508  failr(mpsr_PutRingLeftv(link, (leftv) idroot->get(m->preimage, 1)));
509#endif /* HAVE_NAMESPACES */
510
511  // Second, the name of the ring
512  mp_failr(MP_PutStringPacket(link, m->preimage,0));
513
514  // and third, the ideal --
515  // supposing that we can cast a map to an ideal
516  return mpsr_PutIdeal(link, (ideal) m, cring);
517}
518
519
520mpsr_Status_t mpsr_PutPackage(MP_Link_pt link, char* pname, idhdl pack)
521{
522  MP_DictTag_t dict;
523  MP_Common_t  cop;
524
525  printf("Huhu\n");
526  failr(mpsr_tok2mp('=', &dict, &cop));
527  printf("Huhu 1\n");
528
529  // A Singular- procedure is sent as a cop with the string as arg
530  mp_failr(MP_PutCommonOperatorPacket(link,
531                                        dict,
532                                        cop,
533                                        0,
534                                        2));
535  printf("Huhu 2\n");
536  mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1));
537  printf("Huhu 3\n");
538  mp_failr(MP_PutAnnotationPacket(link,
539                                  MP_SingularDict,
540                                  0,
541                                  0));
542  printf("Huhu 4\n");
543  mp_return(MP_Success);
544}
545
546/***************************************************************
547 *
548 * A routine which dumps the content of Singular to a file
549 *
550 ***************************************************************/
551mpsr_Status_t mpsr_PutDump(MP_Link_pt link)
552{
553  idhdl h = IDROOT, h2 = NULL, rh = currRingHdl;
554  ring r;
555  sip_command cmd;
556  leftv lv;
557
558  mpsr_ClearError();
559  memset(&(cmd), 0, sizeof(sip_command));
560  cmd.argc = 2;
561  cmd.op = '=';
562  cmd.arg1.rtyp = DEF_CMD;
563  lv = mpsr_InitLeftv(COMMAND, (void *) &cmd);
564
565  MP_ResetLink(link);
566  while (h != NULL && h2 == NULL)
567  {
568
569    if (IDTYP(h) == PROC_CMD)
570    {
571      failr(mpsr_PutLeftv(link, (leftv) h, NULL));
572#ifdef MPSR_DEBUG
573      Print("Dumped Proc %s\n", IDID(h));
574#endif
575    }
576    // do not dump LIB string and Links
577    else if (!(IDTYP(h) == STRING_CMD && strcmp("LIB", IDID(h)) == 0) &&
578             IDTYP(h) != LINK_CMD)
579    {
580      cmd.arg1.name = IDID(h);
581      //cmd.arg2.next = h->next;
582      cmd.arg1.name = IDID(h);
583      cmd.arg2.data=IDDATA(h);
584      cmd.arg2.flag=h->flag;
585      cmd.arg2.attribute=h->attribute;
586      cmd.arg2.rtyp=h->typ;
587      //cmd.arg2.e = NULL;
588      //cmd.arg2.muell = 0;
589      //memcpy(&(cmd.arg2), h, sizeof(sleftv));
590      if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success) break;
591#ifdef MPSR_DEBUG
592      Print("Dumped %s\n", IDID(h));
593#endif
594      if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD)
595      {
596        // we don't really need to do that, it's only for convenience
597        // for putting numbers
598        rSetHdl(h, TRUE);
599        r = IDRING(h);
600        h2 = r->idroot;
601        while (h2 != NULL)
602        {
603          //cmd.arg2.next = h->next;
604          cmd.arg1.name = IDID(h2);
605          cmd.arg2.data=IDDATA(h2);
606          cmd.arg2.flag = h2->flag;
607          cmd.arg2.attribute = h2->attribute;
608          cmd.arg2.rtyp = h2->typ;
609          //cmd.arg2.e = NULL;
610          //cmd.arg2.muell = 0;
611          //memcpy(&(cmd.arg2), h2, sizeof(sleftv));
612          if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
613#ifdef MPSR_DEBUG
614          Print("Dumped %s\n", IDID(h2));
615#endif
616          h2 = h2->next;
617        }
618      }
619    }
620
621    h = h->next;
622  }
623  MP_EndMsg(link);
624  Free(lv, sizeof(sleftv));
625  if (rh != NULL && rh != currRingHdl) rSetHdl(rh, TRUE);
626
627  if (h == NULL && h2 == NULL)
628    return mpsr_Success;
629  else
630    return mpsr_Failure;
631}
632
633#endif // HAVE_MPSR
634
635
Note: See TracBrowser for help on using the repository browser.