Context Navigation

source: git/Singular/mpsr_Put.cc @ 551fd7

spielwiese

Last change on this file since 551fd7 was 416465, checked in by Olaf Bachmann <obachman@…>, 24 years ago
* bug-fixes from work with Thomas git-svn-id: file:///usr/local/Singular/svn/trunk@3826 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 20.4 KB

Line
1	/****************************************
2	* Computer Algebra System SINGULAR *
3	****************************************/
4	/* $Id: mpsr_Put.cc,v 1.19 1999-11-15 17:20:34 obachman Exp $ */
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 "mod2.h"
18
19	#ifdef HAVE_MPSR
20
21	#include "mpsr_Put.h"
22	#include "mpsr_Tok.h"
23	#include "intvec.h"
24	#include "lists.h"
25	#include "numbers.h"
26	#include "polys.h"
27	#include "sing_mp.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
47	mpsr_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
70	mpsr_Status_t mpsr_PutLeftv(MP_Link_pt link, leftv v, ring cring)
71	{
72	idtyp 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	***************************************************************/
144	mpsr_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
171	mpsr_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
210	mpsr_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
220	mpsr_Status_t mpsr_PutProc(MP_Link_pt link, 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	mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1));
235	mp_failr(MP_PutAnnotationPacket(link,
236	MP_SingularDict,
237	MP_AnnotSingularProcDef,
238	0));
239	if( proc->language == LANG_SINGULAR) {
240	if (proc->data.s.body == NULL)
241	iiGetLibProcBuffer(proc);
242	mp_return(MP_PutStringPacket(link, proc->data.s.body, 0));
243	}
244	else
245	mp_return(MP_PutStringPacket(link, "", 0));
246	mp_return(MP_Success);
247	}
248
249
250	/***************************************************************
251	* the Third-level data routines which are ring-dependent
252	*
253	***************************************************************/
254
255	inline mpsr_Status_t PutLeftvChain(MP_Link_pt link, leftv lv, ring r)
256	{
257	while (lv != NULL)
258	{
259	failr(mpsr_PutLeftv(link, lv, r));
260	lv = lv->next;
261	}
262	return mpsr_Success;
263	}
264
265	mpsr_Status_t mpsr_PutList(MP_Link_pt link, lists l, ring cring)
266	{
267	int i, nl = l->nr + 1;
268
269	mp_failr(MP_PutCommonOperatorPacket(link,
270	MP_BasicDict,
271	MP_CopBasicList,
272	0,
273	nl));
274	for (i=0; i<nl; i++)
275	failr(mpsr_PutLeftv(link, &(l->m[i]), cring));
276
277	return mpsr_Success;
278	}
279
280	mpsr_Status_t mpsr_PutCopCommand(MP_Link_pt link, command cmd, ring cring)
281	{
282	MP_Common_t cop;
283	MP_DictTag_t dict;
284	MP_NumChild_t nc = cmd->argc;
285	leftv l;
286
287	// First, we get the command cop -- at the moment, everything should be
288	// a MP cop
289	failr(mpsr_tok2mp(cmd->op, &dict, &cop));
290
291	// and put the common operator
292	mp_failr(MP_PutCommonOperatorPacket(link, dict, cop, 0, nc));
293
294	// now we Put the arguments
295	if (nc > 0)
296	{
297	if (nc <= 3)
298	{
299	failr(mpsr_PutLeftv(link, &(cmd->arg1), cring));
300	if (nc >1)
301	{
302	failr(mpsr_PutLeftv(link, &(cmd->arg2), cring));
303	if (nc == 3) return mpsr_PutLeftv(link, &(cmd->arg3), cring);
304	else return mpsr_Success;
305	}
306	else return mpsr_Success;
307	}
308	else
309	return PutLeftvChain(link, &(cmd->arg1), cring);
310	}
311	return mpsr_Success;
312	}
313
314	mpsr_Status_t mpsr_PutOpCommand(MP_Link_pt link, command cmd, ring cring)
315	{
316	mp_failr(MP_PutOperatorPacket(link,
317	MP_SingularDict,
318	(char *) (cmd->arg1.Data()),
319	0,
320	(cmd->argc <= 1 ? 0 :(cmd->arg2).listLength())));
321	if (cmd->argc > 1)
322	return PutLeftvChain(link, &(cmd->arg2), cring);
323	else
324	return mpsr_Success;
325	}
326
327	// Numbers are put as polys with one monomial and all exponents zero
328	mpsr_Status_t mpsr_PutNumber(MP_Link_pt link, number n, ring cring)
329	{
330	ring rr = NULL;
331	poly p = NULL;
332	mpsr_Status_t r;
333
334	if (currRing != cring)
335	{
336	rr = currRing;
337	mpsr_SetCurrRing(cring, TRUE);
338	}
339
340	if (!nIsZero(n))
341	{
342	p = pOne();
343	pSetCoeff(p, nCopy(n));
344	}
345	r = mpsr_PutPoly(link, p, cring);
346	pDelete(&p);
347
348	if (rr != NULL) mpsr_SetCurrRing(rr, TRUE);
349
350	return r;
351	}
352
353	mpsr_Status_t mpsr_PutPoly(MP_Link_pt link, poly p, ring cring)
354	{
355	mp_failr(MP_PutCommonOperatorPacket(link,
356	MP_PolyDict,
357	MP_CopPolyDenseDistPoly,
358	mpsr_GetNumOfRingAnnots(cring, 0),
359	pLength(p)));
360	failr(mpsr_PutRingAnnots(link, cring, 0));
361	return mpsr_PutPolyData(link, p, cring);
362	}
363
364
365	mpsr_Status_t mpsr_PutPolyVector(MP_Link_pt link, poly p, ring cring)
366	{
367	mp_failr(MP_PutCommonOperatorPacket(link,
368	MP_PolyDict,
369	MP_CopPolyDenseDistPoly,
370	mpsr_GetNumOfRingAnnots(cring,1),
371	pLength(p)));
372	failr(mpsr_PutRingAnnots(link, cring, 1));
373	return mpsr_PutPolyVectorData(link, p, cring);
374	}
375
376
377	mpsr_Status_t mpsr_PutIdeal(MP_Link_pt link, ideal id, ring cring)
378	{
379	int i, idn = IDELEMS(id);
380
381	mp_failr(MP_PutCommonOperatorPacket(link,
382	MP_PolyDict,
383	MP_CopPolyIdeal,
384	1,
385	idn));
386	mp_failr(MP_PutAnnotationPacket(link,
387	MP_ProtoDict,
388	MP_AnnotProtoPrototype,
389	MP_AnnotReqValNode));
390	mp_failr(MP_PutCommonMetaOperatorPacket(link,
391	MP_PolyDict,
392	MP_CopPolyDenseDistPoly,
393	mpsr_GetNumOfRingAnnots(cring, 0),
394	0));
395	failr(mpsr_PutRingAnnots(link, cring, 0));
396
397	for (i=0; i < idn; i++)
398	{
399	IMP_PutUint32(link, pLength(id->m[i]));
400	failr(mpsr_PutPolyData(link, id->m[i], cring));
401	}
402	return mpsr_Success;
403	}
404
405	mpsr_Status_t mpsr_PutModule(MP_Link_pt link, ideal id, ring cring)
406	{
407	int i, idn = IDELEMS(id);
408
409	mp_failr(MP_PutCommonOperatorPacket(link,
410	MP_PolyDict,
411	MP_CopPolyModule,
412	2,
413	idn));
414	mp_failr(MP_PutAnnotationPacket(link,
415	MP_ProtoDict,
416	MP_AnnotProtoPrototype,
417	MP_AnnotReqValNode));
418	mp_failr(MP_PutCommonMetaOperatorPacket(link,
419	MP_PolyDict,
420	MP_CopPolyDenseDistPoly,
421	mpsr_GetNumOfRingAnnots(cring, 1),
422	0));
423	failr(mpsr_PutRingAnnots(link, cring, 1));
424
425	mp_failr(MP_PutAnnotationPacket(link,
426	MP_PolyDict,
427	MP_AnnotPolyModuleRank,
428	MP_AnnotValuated));
429	mp_failr(MP_PutUint32Packet(link, id->rank, 0));
430
431	for (i=0; i < idn; i++)
432	{
433	IMP_PutUint32(link, pLength(id->m[i]));
434	failr(mpsr_PutPolyVectorData(link, id->m[i], cring));
435	}
436	return mpsr_Success;
437	}
438
439	mpsr_Status_t mpsr_PutMatrix(MP_Link_pt link, ideal id, ring cring)
440	{
441	int nrows = id->nrows, ncols = id->ncols;
442	MP_Uint32_t n = nrows*ncols, i;
443
444	// First, we put the Matrix operator
445	mp_failr(MP_PutCommonOperatorPacket(link,
446	MP_MatrixDict,
447	MP_CopMatrixDenseMatrix,
448	2,
449	n));
450	// Put the two annotations
451	// First, the prototype annot
452	mp_failr(MP_PutAnnotationPacket(link,
453	MP_ProtoDict,
454	MP_AnnotProtoPrototype,
455	MP_AnnotReqValNode));
456	mp_failr(MP_PutCommonMetaOperatorPacket(link,
457	MP_PolyDict,
458	MP_CopPolyDenseDistPoly,
459	mpsr_GetNumOfRingAnnots(cring, 0),
460	0));
461	failr(mpsr_PutRingAnnots(link, cring, 0));
462
463	// second, the matrix dim annot
464	mp_failr(MP_PutAnnotationPacket(link,
465	MP_MatrixDict,
466	MP_AnnotMatrixDimension,
467	MP_AnnotReqValNode));
468	// which specifies the dimesnion of the matrix
469	mp_failr(MP_PutCommonOperatorPacket(link,
470	MP_BasicDict,
471	MP_CopBasicList,
472	0, 2));
473	mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) nrows, 0));
474	mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) ncols, 0));
475
476	// And finally, we put the elments
477	for (i=0; i < n; i++)
478	{
479	IMP_PutUint32(link, pLength(id->m[i]));
480	failr(mpsr_PutPolyData(link, id->m[i], cring));
481	}
482	return mpsr_Success;
483	}
484
485
486	// We communicate a map as an operator having three arguments: A ring,
487	// its name and an ideal
488	mpsr_Status_t mpsr_PutMap(MP_Link_pt link, map m, ring cring)
489	{
490	MP_Uint32_t i, idn = IDELEMS((ideal) m);
491	MP_DictTag_t dict;
492	MP_Common_t cop;
493
494	failr(mpsr_tok2mp(MAP_CMD, &dict, &cop));
495
496	mp_failr(MP_PutCommonOperatorPacket(link,
497	dict,
498	cop,
499	0,
500	3));
501	// First, is the ring
502	#ifdef HAVE_NAMESPACES
503	failr(mpsr_PutRingLeftv(link, (leftv) namespaceroot->get(m->preimage, 1)));
504	#else /* HAVE_NAMESPACES */
505	failr(mpsr_PutRingLeftv(link, (leftv) idroot->get(m->preimage, 1)));
506	#endif /* HAVE_NAMESPACES */
507
508	// Second, the name of the ring
509	mp_failr(MP_PutStringPacket(link, m->preimage,0));
510
511	// and third, the ideal --
512	// supposing that we can cast a map to an ideal
513	return mpsr_PutIdeal(link, (ideal) m, cring);
514	}
515
516	mpsr_Status_t mpsr_PutPackage(MP_Link_pt link, package pack)
517	{
518	MP_DictTag_t dict;
519	MP_Common_t cop;
520
521	failr(mpsr_tok2mp(PACKAGE_CMD, &dict, &cop));
522
523	// A Singular- procedure is sent as a cop with the string as arg
524	mp_failr(MP_PutCommonOperatorPacket(link,
525	dict,
526	cop,
527	1,
528	(pack->language != LANG_NONE &&
529	pack->language != LANG_TOP ? 1 : 0)));
530	mp_failr(MP_PutAnnotationPacket(link,
531	MP_SingularDict,
532	MP_AnnotSingularPackageType,
533	MP_AnnotValuated));
534	mp_failr(MP_PutUint8Packet(link, (unsigned char) pack->language, 0));
535	if (pack->language != LANG_NONE && pack->language != LANG_TOP)
536	{
537	assume(pack->libname != NULL);
538	mp_failr(MP_PutStringPacket(link, pack->libname, 0));
539	}
540	mp_return(MP_Success);
541	}
542
543	/***************************************************************
544	*
545	* A routine which dumps the content of Singular to a file
546	*
547	***************************************************************/
548	mpsr_Status_t mpsr_PutDump(MP_Link_pt link)
549	{
550	idhdl h = IDROOT, h2 = NULL, rh = currRingHdl;
551	ring r;
552	sip_command cmd;
553	leftv lv;
554
555	mpsr_ClearError();
556	memset(&(cmd), 0, sizeof(sip_command));
557	cmd.argc = 2;
558	cmd.op = '=';
559	cmd.arg1.rtyp = DEF_CMD;
560	lv = mpsr_InitLeftv(COMMAND, (void *) &cmd);
561
562	MP_ResetLink(link);
563	while (h != NULL && h2 == NULL)
564	{
565
566	if (IDTYP(h) == PROC_CMD)
567	{
568	failr(mpsr_PutLeftv(link, (leftv) h, NULL));
569	#ifdef MPSR_DEBUG
570	Print("Dumped Proc %s\n", IDID(h));
571	#endif
572	}
573	// do not dump LIB string and Links and Top PACKAGE
574	else if (!(IDTYP(h) == STRING_CMD && strcmp("LIB", IDID(h)) == 0) &&
575	IDTYP(h) != LINK_CMD &&
576	! (IDTYP(h) == PACKAGE_CMD && strcmp(IDID(h), "Top") == 0))
577	{
578	#ifdef HAVE_NAMESPACES
579	cmd.arg1.name = (char*)
580	AllocL(strlen(IDID(h)) + strlen(namespaceroot->name) + 3);
581	sprintf(cmd.arg1.name, "%s::%s", namespaceroot->name, IDID(h));
582	#else
583	cmd.arg1.name = IDID(h);
584	#endif
585	cmd.arg2.data=IDDATA(h);
586	cmd.arg2.flag=h->flag;
587	cmd.arg2.attribute=h->attribute;
588	cmd.arg2.rtyp=h->typ;
589	#ifdef HAVE_NAMESPACES
590	if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success)
591	{
592	FreeL(cmd.arg1.name);
593	break;
594	}
595	FreeL(cmd.arg1.name);
596	#else
597	if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
598	#endif
599
600	#ifdef MPSR_DEBUG
601	Print("Dumped %s\n", IDID(h));
602	#endif
603	if (IDTYP(h) == RING_CMD \|\| IDTYP(h) == QRING_CMD \|\|
604	(IDTYP(h) == PACKAGE_CMD && strcmp(IDID(h), "Top") != 0))
605	{
606	// we don't really need to do that, it's only for convenience
607	// for putting numbers
608	if (IDTYP(h) == PACKAGE_CMD)
609	{
610	namespaceroot->push(IDPACKAGE(h), IDID(h));
611	h2 = IDPACKAGE(h)->idroot;
612	}
613	else
614	{
615	rSetHdl(h, TRUE);
616	r = IDRING(h);
617	h2 = r->idroot;
618	}
619	while (h2 != NULL)
620	{
621	#ifdef HAVE_NAMESPACES
622	cmd.arg1.name = (char*)
623	AllocL(strlen(IDID(h2)) + strlen(namespaceroot->name) + 3);
624	sprintf(cmd.arg1.name, "%s::%s", namespaceroot->name, IDID(h2));
625	#else
626	cmd.arg1.name = IDID(h2);
627	#endif
628	cmd.arg2.data=IDDATA(h2);
629	cmd.arg2.flag = h2->flag;
630	cmd.arg2.attribute = h2->attribute;
631	cmd.arg2.rtyp = h2->typ;
632	#ifdef HAVE_NAMESPACES
633	if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success)
634	{
635	FreeL(cmd.arg1.name);
636	break;
637	}
638	FreeL(cmd.arg1.name);
639	#else
640	if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
641	#endif
642	#ifdef MPSR_DEBUG
643	Print("Dumped %s\n", IDID(h2));
644	#endif
645	h2 = h2->next;
646	}
647	if (IDTYP(h) == PACKAGE_CMD)
648	{
649	namespaceroot->pop();
650	}
651	}
652	}
653
654	h = h->next;
655	}
656	MP_EndMsg(link);
657	FreeSizeOf(lv, sleftv);
658	if (rh != NULL && rh != currRingHdl) rSetHdl(rh, TRUE);
659
660	if (h == NULL && h2 == NULL)
661	return mpsr_Success;
662	else
663	return mpsr_Failure;
664	}
665
666	#endif // HAVE_MPSR
667
668

Note: See TracBrowser for help on using the repository browser.

Download in other formats: