Context Navigation

source: git/Singular/mpsr_Put.cc @ de7793

spielwiese

Last change on this file since de7793 was de7793, checked in by Olaf Bachmann <obachman@…>, 23 years ago
* bug fixes git-svn-id: file:///usr/local/Singular/svn/trunk@4866 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.25 2000-12-12 11:03:00 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
28	/***************************************************************
29	*
30	* There are 4 different layers on which things are put:
31	* 1.) Singular Top-level Data (chains of leftv's) == MP message
32	* 2.) Single leftv's
33	* 3.) Plain Singular data (different Singular data types)
34	* 4.) Primitive polynomial Data
35	*
36	***************************************************************/
37
38	/***************************************************************
39	* 1.) Routines for Top-level Data
40	*
41	***************************************************************/
42	// this puts everything it finds in a leftv on the MP-link in form of
43	// a message; Each leftv is sent as one MP Tree. The leftvs in a chain
44	// of leftv's (i.e. for v->next != NULL) are sent as separate MP Trees
45	// within the same MP message
46	mpsr_Status_t mpsr_PutMsg(MP_Link_pt l, leftv v)
47	{
48	mpsr_Status_t status = mpsr_Success;
49
50	MP_ResetLink(l);
51	while (v != NULL && status == mpsr_Success)
52	{
53	status = mpsr_PutLeftv(l, v, currRing);
54	v = v->next;
55	}
56	MP_EndMsg(l);
57
58	return status;
59	}
60
61
62	/***************************************************************
63	* Second-level data routines
64	* All the mpsr_Put*Leftv functions are defined as inline's in the header
65	*
66	***************************************************************/
67
68	// This already depends on the ring
69	mpsr_Status_t mpsr_PutLeftv(MP_Link_pt link, leftv v, ring cring)
70	{
71	idtyp type = v->Typ();
72
73	switch(type)
74	{
75	// first, all the ring-independent types
76	case INT_CMD:
77	return mpsr_PutIntLeftv(link,v);
78
79	case INTVEC_CMD:
80	return mpsr_PutIntVecLeftv(link, v);
81
82	case INTMAT_CMD:
83	return mpsr_PutIntMatLeftv(link, v);
84
85	case STRING_CMD:
86	return mpsr_PutStringLeftv(link, v);
87
88	case RING_CMD:
89	return mpsr_PutRingLeftv(link, v);
90
91	case QRING_CMD:
92	return mpsr_PutQRingLeftv(link, v);
93
94	case PROC_CMD:
95	return mpsr_PutProcLeftv(link, v);
96
97	case DEF_CMD:
98	return mpsr_PutDefLeftv(link, v);
99
100	// now potentially ring-dependent types
101	case LIST_CMD:
102	return mpsr_PutListLeftv(link,v, cring);
103
104	case COMMAND:
105	return mpsr_PutCommandLeftv(link,v, cring);
106
107	case NUMBER_CMD:
108	return mpsr_PutNumberLeftv(link,v, cring);
109
110	case POLY_CMD:
111	return mpsr_PutPolyLeftv(link, v, cring);
112
113	case IDEAL_CMD:
114	return mpsr_PutIdealLeftv(link, v, cring);
115
116	case VECTOR_CMD:
117	return mpsr_PutVectorLeftv(link, v, cring);
118
119	case MODUL_CMD:
120	return mpsr_PutModuleLeftv(link, v, cring);
121
122	case MATRIX_CMD:
123	return mpsr_PutMatrixLeftv(link,v, cring);
124
125	case MAP_CMD:
126	return mpsr_PutMapLeftv(link, v, cring);
127
128	case PACKAGE_CMD:
129	return mpsr_PutPackageLeftv(link, v);
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	***************************************************************/
143	mpsr_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
170	mpsr_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_PutSint32Packet(link, (MP_Sint32_t) r, 0));
202	mp_failr(MP_PutSint32Packet(link, (MP_Sint32_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
209	mpsr_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
219	mpsr_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	if (pname==NULL)
234	pname=proc->procname;
235
236	mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1));
237	mp_failr(MP_PutAnnotationPacket(link,
238	MP_SingularDict,
239	MP_AnnotSingularProcDef,
240	0));
241	if( proc->language == LANG_SINGULAR) {
242	if (proc->data.s.body == NULL)
243	iiGetLibProcBuffer(proc);
244	mp_return(MP_PutStringPacket(link, proc->data.s.body, 0));
245	}
246	else
247	mp_return(MP_PutStringPacket(link, "", 0));
248	mp_return(MP_Success);
249	}
250
251
252	/***************************************************************
253	* the Third-level data routines which are ring-dependent
254	*
255	***************************************************************/
256
257	inline mpsr_Status_t PutLeftvChain(MP_Link_pt link, leftv lv, ring r)
258	{
259	while (lv != NULL)
260	{
261	failr(mpsr_PutLeftv(link, lv, r));
262	lv = lv->next;
263	}
264	return mpsr_Success;
265	}
266
267	mpsr_Status_t mpsr_PutList(MP_Link_pt link, lists l, ring cring)
268	{
269	int i, nl = l->nr + 1;
270
271	mp_failr(MP_PutCommonOperatorPacket(link,
272	MP_BasicDict,
273	MP_CopBasicList,
274	0,
275	nl));
276	for (i=0; i<nl; i++)
277	failr(mpsr_PutLeftv(link, &(l->m[i]), cring));
278
279	return mpsr_Success;
280	}
281
282	mpsr_Status_t mpsr_PutCopCommand(MP_Link_pt link, command cmd, ring cring)
283	{
284	MP_Common_t cop;
285	MP_DictTag_t dict;
286	MP_NumChild_t nc = cmd->argc;
287	leftv l;
288
289	// First, we get the command cop -- at the moment, everything should be
290	// a MP cop
291	failr(mpsr_tok2mp(cmd->op, &dict, &cop));
292
293	// and put the common operator
294	mp_failr(MP_PutCommonOperatorPacket(link, dict, cop, 0, nc));
295
296	// now we Put the arguments
297	if (nc > 0)
298	{
299	if (nc <= 3)
300	{
301	failr(mpsr_PutLeftv(link, &(cmd->arg1), cring));
302	if (nc >1)
303	{
304	failr(mpsr_PutLeftv(link, &(cmd->arg2), cring));
305	if (nc == 3) return mpsr_PutLeftv(link, &(cmd->arg3), cring);
306	else return mpsr_Success;
307	}
308	else return mpsr_Success;
309	}
310	else
311	return PutLeftvChain(link, &(cmd->arg1), cring);
312	}
313	return mpsr_Success;
314	}
315
316	mpsr_Status_t mpsr_PutOpCommand(MP_Link_pt link, command cmd, ring cring)
317	{
318	mp_failr(MP_PutOperatorPacket(link,
319	MP_SingularDict,
320	(char *) (cmd->arg1.Data()),
321	0,
322	(cmd->argc <= 1 ? 0 :(cmd->arg2).listLength())));
323	if (cmd->argc > 1)
324	return PutLeftvChain(link, &(cmd->arg2), cring);
325	else
326	return mpsr_Success;
327	}
328
329	// Numbers are put as polys with one monomial and all exponents zero
330	mpsr_Status_t mpsr_PutNumber(MP_Link_pt link, number n, ring cring)
331	{
332	ring rr = NULL;
333	poly p = NULL;
334	mpsr_Status_t r;
335
336	if (currRing != cring)
337	{
338	rr = currRing;
339	mpsr_SetCurrRing(cring, TRUE);
340	}
341
342	if (!nIsZero(n))
343	{
344	p = pOne();
345	pSetCoeff(p, nCopy(n));
346	}
347	r = mpsr_PutPoly(link, p, cring);
348	pDelete(&p);
349
350	if (rr != NULL) mpsr_SetCurrRing(rr, TRUE);
351
352	return r;
353	}
354
355	mpsr_Status_t mpsr_PutPoly(MP_Link_pt link, poly p, ring cring)
356	{
357	mp_failr(MP_PutCommonOperatorPacket(link,
358	MP_PolyDict,
359	MP_CopPolyDenseDistPoly,
360	mpsr_GetNumOfRingAnnots(cring, 0),
361	pLength(p)));
362	failr(mpsr_PutRingAnnots(link, cring, 0));
363	return mpsr_PutPolyData(link, p, cring);
364	}
365
366
367	mpsr_Status_t mpsr_PutPolyVector(MP_Link_pt link, poly p, ring cring)
368	{
369	mp_failr(MP_PutCommonOperatorPacket(link,
370	MP_PolyDict,
371	MP_CopPolyDenseDistPoly,
372	mpsr_GetNumOfRingAnnots(cring,1),
373	pLength(p)));
374	failr(mpsr_PutRingAnnots(link, cring, 1));
375	return mpsr_PutPolyVectorData(link, p, cring);
376	}
377
378
379	mpsr_Status_t mpsr_PutIdeal(MP_Link_pt link, ideal id, ring cring)
380	{
381	int i, idn = IDELEMS(id);
382
383	mp_failr(MP_PutCommonOperatorPacket(link,
384	MP_PolyDict,
385	MP_CopPolyIdeal,
386	1,
387	idn));
388	mp_failr(MP_PutAnnotationPacket(link,
389	MP_ProtoDict,
390	MP_AnnotProtoPrototype,
391	MP_AnnotReqValNode));
392	mp_failr(MP_PutCommonMetaOperatorPacket(link,
393	MP_PolyDict,
394	MP_CopPolyDenseDistPoly,
395	mpsr_GetNumOfRingAnnots(cring, 0),
396	0));
397	failr(mpsr_PutRingAnnots(link, cring, 0));
398
399	for (i=0; i < idn; i++)
400	{
401	IMP_PutUint32(link, pLength(id->m[i]));
402	failr(mpsr_PutPolyData(link, id->m[i], cring));
403	}
404	return mpsr_Success;
405	}
406
407	mpsr_Status_t mpsr_PutModule(MP_Link_pt link, ideal id, ring cring)
408	{
409	int i, idn = IDELEMS(id);
410
411	mp_failr(MP_PutCommonOperatorPacket(link,
412	MP_PolyDict,
413	MP_CopPolyModule,
414	2,
415	idn));
416	mp_failr(MP_PutAnnotationPacket(link,
417	MP_ProtoDict,
418	MP_AnnotProtoPrototype,
419	MP_AnnotReqValNode));
420	mp_failr(MP_PutCommonMetaOperatorPacket(link,
421	MP_PolyDict,
422	MP_CopPolyDenseDistPoly,
423	mpsr_GetNumOfRingAnnots(cring, 1),
424	0));
425	failr(mpsr_PutRingAnnots(link, cring, 1));
426
427	mp_failr(MP_PutAnnotationPacket(link,
428	MP_PolyDict,
429	MP_AnnotPolyModuleRank,
430	MP_AnnotValuated));
431	mp_failr(MP_PutUint32Packet(link, id->rank, 0));
432
433	for (i=0; i < idn; i++)
434	{
435	IMP_PutUint32(link, pLength(id->m[i]));
436	failr(mpsr_PutPolyVectorData(link, id->m[i], cring));
437	}
438	return mpsr_Success;
439	}
440
441	mpsr_Status_t mpsr_PutMatrix(MP_Link_pt link, ideal id, ring cring)
442	{
443	int nrows = id->nrows, ncols = id->ncols;
444	MP_Uint32_t n = nrows*ncols, i;
445
446	// First, we put the Matrix operator
447	mp_failr(MP_PutCommonOperatorPacket(link,
448	MP_MatrixDict,
449	MP_CopMatrixDenseMatrix,
450	2,
451	n));
452	// Put the two annotations
453	// First, the prototype annot
454	mp_failr(MP_PutAnnotationPacket(link,
455	MP_ProtoDict,
456	MP_AnnotProtoPrototype,
457	MP_AnnotReqValNode));
458	mp_failr(MP_PutCommonMetaOperatorPacket(link,
459	MP_PolyDict,
460	MP_CopPolyDenseDistPoly,
461	mpsr_GetNumOfRingAnnots(cring, 0),
462	0));
463	failr(mpsr_PutRingAnnots(link, cring, 0));
464
465	// second, the matrix dim annot
466	mp_failr(MP_PutAnnotationPacket(link,
467	MP_MatrixDict,
468	MP_AnnotMatrixDimension,
469	MP_AnnotReqValNode));
470	// which specifies the dimesnion of the matrix
471	mp_failr(MP_PutCommonOperatorPacket(link,
472	MP_BasicDict,
473	MP_CopBasicList,
474	0, 2));
475	mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) nrows, 0));
476	mp_failr(MP_PutSint32Packet(link, (MP_Sint32_t) ncols, 0));
477
478	// And finally, we put the elments
479	for (i=0; i < n; i++)
480	{
481	IMP_PutUint32(link, pLength(id->m[i]));
482	failr(mpsr_PutPolyData(link, id->m[i], cring));
483	}
484	return mpsr_Success;
485	}
486
487
488	// We communicate a map as an operator having three arguments: A ring,
489	// its name and an ideal
490	mpsr_Status_t mpsr_PutMap(MP_Link_pt link, map m, ring cring)
491	{
492	MP_Uint32_t i, idn = IDELEMS((ideal) m);
493	MP_DictTag_t dict;
494	MP_Common_t cop;
495
496	failr(mpsr_tok2mp(MAP_CMD, &dict, &cop));
497
498	mp_failr(MP_PutCommonOperatorPacket(link,
499	dict,
500	cop,
501	0,
502	3));
503	// First, is the ring
504	#ifdef HAVE_NAMESPACES
505	failr(mpsr_PutRingLeftv(link, (leftv) namespaceroot->get(m->preimage, 1)));
506	#else /* HAVE_NAMESPACES */
507	failr(mpsr_PutRingLeftv(link, (leftv) idroot->get(m->preimage, 1)));
508	#endif /* HAVE_NAMESPACES */
509
510	// Second, the name of the ring
511	mp_failr(MP_PutStringPacket(link, m->preimage,0));
512
513	// and third, the ideal --
514	// supposing that we can cast a map to an ideal
515	return mpsr_PutIdeal(link, (ideal) m, cring);
516	}
517
518	mpsr_Status_t mpsr_PutPackage(MP_Link_pt link, package pack)
519	{
520	MP_DictTag_t dict;
521	MP_Common_t cop;
522
523	failr(mpsr_tok2mp(PACKAGE_CMD, &dict, &cop));
524
525	// A Singular- procedure is sent as a cop with the string as arg
526	mp_failr(MP_PutCommonOperatorPacket(link,
527	dict,
528	cop,
529	1,
530	(pack->language != LANG_NONE &&
531	pack->language != LANG_TOP ? 1 : 0)));
532	mp_failr(MP_PutAnnotationPacket(link,
533	MP_SingularDict,
534	MP_AnnotSingularPackageType,
535	MP_AnnotValuated));
536	mp_failr(MP_PutUint8Packet(link, (unsigned char) pack->language, 0));
537	if (pack->language != LANG_NONE && pack->language != LANG_TOP)
538	{
539	assume(pack->libname != NULL);
540	mp_failr(MP_PutStringPacket(link, pack->libname, 0));
541	}
542	mp_return(MP_Success);
543	}
544
545	/***************************************************************
546	*
547	* A routine which dumps the content of Singular to a file
548	*
549	***************************************************************/
550	mpsr_Status_t mpsr_PutDump(MP_Link_pt link)
551	{
552	idhdl h = IDROOT, h2 = NULL, rh = currRingHdl;
553	ring r;
554	sip_command cmd;
555	leftv lv;
556
557	mpsr_ClearError();
558	memset(&(cmd), 0, sizeof(sip_command));
559	cmd.argc = 2;
560	cmd.op = '=';
561	cmd.arg1.rtyp = DEF_CMD;
562	lv = mpsr_InitLeftv(COMMAND, (void *) &cmd);
563
564	MP_ResetLink(link);
565	while (h != NULL && h2 == NULL)
566	{
567
568	if (IDTYP(h) == PROC_CMD)
569	{
570	failr(mpsr_PutLeftv(link, (leftv) h, NULL));
571	#ifdef MPSR_DEBUG_DUMP
572	Print("Dumped Proc %s\n", IDID(h));
573	#endif
574	}
575	// do not dump LIB string and Links and Top PACKAGE
576	else if (!(IDTYP(h) == STRING_CMD && strcmp("LIB", IDID(h)) == 0) &&
577	IDTYP(h) != LINK_CMD &&
578	! (IDTYP(h) == PACKAGE_CMD && strcmp(IDID(h), "Top") == 0))
579	{
580	#ifdef HAVE_NAMESPACES
581	cmd.arg1.name = (char*)
582	omAlloc(strlen(IDID(h)) + strlen(namespaceroot->name) + 3);
583	sprintf(cmd.arg1.name, "%s::%s", namespaceroot->name, IDID(h));
584	#else
585	cmd.arg1.name = IDID(h);
586	#endif
587	cmd.arg2.data=IDDATA(h);
588	cmd.arg2.flag=h->flag;
589	cmd.arg2.attribute=h->attribute;
590	cmd.arg2.rtyp=h->typ;
591	#ifdef HAVE_NAMESPACES
592	if (mpsr_PutLeftv(link, lv , r) != mpsr_Success)
593	{
594	omFree(cmd.arg1.name);
595	break;
596	}
597	omFree(cmd.arg1.name);
598	#else
599	if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
600	#endif
601
602	#ifdef MPSR_DEBUG_DUMP
603	Print("Dumped %s\n", IDID(h));
604	#endif
605	if (IDTYP(h) == RING_CMD \|\| IDTYP(h) == QRING_CMD \|\|
606	(IDTYP(h) == PACKAGE_CMD && strcmp(IDID(h), "Top") != 0))
607	{
608	// we don't really need to do that, it's only for convenience
609	// for putting numbers
610	if (IDTYP(h) == PACKAGE_CMD)
611	{
612	namespaceroot->push(IDPACKAGE(h), IDID(h));
613	h2 = IDPACKAGE(h)->idroot;
614	}
615	else
616	{
617	rSetHdl(h);
618	r = IDRING(h);
619	h2 = r->idroot;
620	}
621	while (h2 != NULL)
622	{
623	#ifdef HAVE_NAMESPACES
624	cmd.arg1.name = (char*)
625	omAlloc(strlen(IDID(h2)) + strlen(namespaceroot->name) + 3);
626	sprintf(cmd.arg1.name, "%s::%s", namespaceroot->name, IDID(h2));
627	#else
628	cmd.arg1.name = IDID(h2);
629	#endif
630	cmd.arg2.data=IDDATA(h2);
631	cmd.arg2.flag = h2->flag;
632	cmd.arg2.attribute = h2->attribute;
633	cmd.arg2.rtyp = h2->typ;
634	#ifdef HAVE_NAMESPACES
635	if (mpsr_PutLeftv(link, lv , r) != mpsr_Success)
636	{
637	omFree(cmd.arg1.name);
638	break;
639	}
640	omFree(cmd.arg1.name);
641	#else
642	if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
643	#endif
644	#ifdef MPSR_DEBUG_DUMP
645	Print("Dumped %s\n", IDID(h2));
646	#endif
647	h2 = h2->next;
648	}
649	if (IDTYP(h) == PACKAGE_CMD)
650	{
651	namespaceroot->pop();
652	}
653	}
654	}
655
656	h = h->next;
657	}
658	MP_EndMsg(link);
659	omFreeBin(lv, sleftv_bin);
660	if (rh != NULL && rh != currRingHdl) rSetHdl(rh);
661
662	if (h == NULL && h2 == NULL)
663	return mpsr_Success;
664	else
665	return mpsr_Failure;
666	}
667
668	#endif // HAVE_MPSR
669
670

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

Download in other formats: