Context Navigation

source: git/Singular/mpsr_Put.cc @ daaa28

fieker-DuValspielwiese

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

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

Download in other formats: