Context Navigation

source: git/Singular/mpsr_Put.cc @ 6f2edc

spielwiese

Last change on this file since 6f2edc was feaddd, checked in by Olaf Bachmann <obachman@…>, 27 years ago
Thu Apr 10 11:59:41 1997 Olaf Bachmann <obachman@ratchwum.mathematik.uni-kl.de (Olaf Bachmann)> * remote quit is now arranged using MP_CopMpQuit * Updated mpsr_* files for new naming convention of MP v:1.1.2 git-svn-id: file:///usr/local/Singular/svn/trunk@146 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 17.2 KB

Line
1	/****************************************
2	* Computer Algebra System SINGULAR *
3	****************************************/
4	/* $Id: mpsr_Put.cc,v 1.6 1997-04-10 13:08:37 obachman Exp $ */
5
6
7	/***************************************************************
8	*
9	* File: mpsr_Put.cc
10	* Purpose: main put routines for MP connection to Singular
11	* Author: Olaf Bachmann (10/95)
12	*
13	* Change History (most recent first):
14	* o 1/97 obachman
15	* Updated putting routines to MP and MPP v1.1
16	*
17	***************************************************************/
18	#include "mod2.h"
19
20	#ifdef HAVE_MPSR
21
22	#include "mpsr_Put.h"
23	#include "mpsr_Tok.h"
24	#include "intvec.h"
25	#include "lists.h"
26	#include "numbers.h"
27	#include "polys.h"
28	#include "sing_mp.h"
29	#include "ring.h"
30
31	/***************************************************************
32	*
33	* There are 4 different layers on which things are put:
34	* 1.) Singular Top-level Data (chains of leftv's) == MP message
35	* 2.) Single leftv's
36	* 3.) Plain Singular data (different Singular data types)
37	* 4.) Primitive polynomial Data
38	*
39	***************************************************************/
40
41	/***************************************************************
42	* 1.) Routines for Top-level Data
43	*
44	***************************************************************/
45	// this puts everything it finds in a leftv on the MP-link in form of
46	// a message; Each leftv is sent as one MP Tree. The leftvs in a chain
47	// of leftv's (i.e. for v->next != NULL) are sent as separate MP Trees
48	// within the same MP message
49	mpsr_Status_t mpsr_PutMsg(MP_Link_pt l, leftv v)
50	{
51	mpsr_Status_t status = mpsr_Success;
52
53	MP_ResetLink(l);
54	while (v != NULL && status == mpsr_Success)
55	{
56	status = mpsr_PutLeftv(l, v, currRing);
57	v = v->next;
58	}
59	MP_EndMsg(l);
60
61	return status;
62	}
63
64
65	/***************************************************************
66	* Second-level data routines
67	* All the mpsr_Put*Leftv functions are defined as inline's in the header
68	*
69	***************************************************************/
70
71	// This already depends on the ring
72	mpsr_Status_t mpsr_PutLeftv(MP_Link_pt link, leftv v, ring cring)
73	{
74	idtyp type = v->Typ();
75
76	switch(type)
77	{
78	// first, all the ring-independent types
79	case INT_CMD:
80	return mpsr_PutIntLeftv(link,v);
81
82	case INTVEC_CMD:
83	return mpsr_PutIntVecLeftv(link, v);
84
85	case INTMAT_CMD:
86	return mpsr_PutIntMatLeftv(link, v);
87
88	case STRING_CMD:
89	return mpsr_PutStringLeftv(link, v);
90
91	case RING_CMD:
92	return mpsr_PutRingLeftv(link, v);
93
94	case QRING_CMD:
95	return mpsr_PutQRingLeftv(link, v);
96
97	case PROC_CMD:
98	return mpsr_PutProcLeftv(link, v);
99
100	case DEF_CMD:
101	return mpsr_PutDefLeftv(link, v);
102
103	// now potentially ring-dependent types
104	case LIST_CMD:
105	return mpsr_PutListLeftv(link,v, cring);
106
107	case COMMAND:
108	return mpsr_PutCommandLeftv(link,v, cring);
109
110	case NUMBER_CMD:
111	return mpsr_PutNumberLeftv(link,v, cring);
112
113	case POLY_CMD:
114	return mpsr_PutPolyLeftv(link, v, cring);
115
116	case IDEAL_CMD:
117	return mpsr_PutIdealLeftv(link, v, cring);
118
119	case VECTOR_CMD:
120	return mpsr_PutVectorLeftv(link, v, cring);
121
122	case MODUL_CMD:
123	return mpsr_PutModuleLeftv(link, v, cring);
124
125	case MATRIX_CMD:
126	return mpsr_PutMatrixLeftv(link,v, cring);
127
128	case MAP_CMD:
129	return mpsr_PutMapLeftv(link, v, cring);
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_PutUint32Packet(link, (MP_Uint32_t) r, 0));
202	mp_failr(MP_PutUint32Packet(link, (MP_Uint32_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, char *proc)
220	{
221	MP_DictTag_t dict;
222	MP_Common_t cop;
223
224	failr(mpsr_tok2mp('=', &dict, &cop));
225
226	// A Singular- procedure is sent as a cop with the string as arg
227	mp_failr(MP_PutCommonOperatorPacket(link,
228	dict,
229	cop,
230	0,
231	2));
232	mp_failr(MP_PutIdentifierPacket(link, MP_SingularDict, pname,1));
233	mp_failr(MP_PutAnnotationPacket(link,
234	MP_SingularDict,
235	MP_AnnotSingularProcDef,
236	0));
237	mp_return(MP_PutStringPacket(link, proc, 0));
238	}
239
240
241	/***************************************************************
242	* the Third-level data routines which are ring-dependent
243	*
244	***************************************************************/
245
246	inline mpsr_Status_t PutLeftvChain(MP_Link_pt link, leftv lv, ring r)
247	{
248	while (lv != NULL)
249	{
250	failr(mpsr_PutLeftv(link, lv, r));
251	lv = lv->next;
252	}
253	return mpsr_Success;
254	}
255
256	mpsr_Status_t mpsr_PutList(MP_Link_pt link, lists l, ring cring)
257	{
258	int i, nl = l->nr + 1;
259
260	mp_failr(MP_PutCommonOperatorPacket(link,
261	MP_BasicDict,
262	MP_CopBasicList,
263	0,
264	nl));
265	for (i=0; i<nl; i++)
266	failr(mpsr_PutLeftv(link, &(l->m[i]), cring));
267
268	return mpsr_Success;
269	}
270
271	mpsr_Status_t mpsr_PutCopCommand(MP_Link_pt link, command cmd, ring cring)
272	{
273	MP_Common_t cop;
274	MP_DictTag_t dict;
275	MP_NumChild_t nc = cmd->argc;
276	leftv l;
277
278	// First, we get the command cop -- at the moment, everything should be
279	// a MP cop
280	failr(mpsr_tok2mp(cmd->op, &dict, &cop));
281
282	// and put the common operator
283	mp_failr(MP_PutCommonOperatorPacket(link, dict, cop, 0, nc));
284
285	// now we Put the arguments
286	if (nc > 0)
287	{
288	if (nc <= 3)
289	{
290	failr(mpsr_PutLeftv(link, &(cmd->arg1), cring));
291	if (nc >1)
292	{
293	failr(mpsr_PutLeftv(link, &(cmd->arg2), cring));
294	if (nc == 3) return mpsr_PutLeftv(link, &(cmd->arg3), cring);
295	else return mpsr_Success;
296	}
297	else return mpsr_Success;
298	}
299	else
300	return PutLeftvChain(link, &(cmd->arg1), cring);
301	}
302	return mpsr_Success;
303	}
304
305	mpsr_Status_t mpsr_PutOpCommand(MP_Link_pt link, command cmd, ring cring)
306	{
307	mp_failr(MP_PutOperatorPacket(link,
308	MP_SingularDict,
309	(char *) (cmd->arg1.Data()),
310	0,
311	(cmd->argc <= 1 ? 0 :(cmd->arg2).listLength())));
312	if (cmd->argc > 1)
313	return PutLeftvChain(link, &(cmd->arg2), cring);
314	else
315	return mpsr_Success;
316	}
317
318	// Numbers are put as polys with one monomial and all exponents zero
319	mpsr_Status_t mpsr_PutNumber(MP_Link_pt link, number n, ring cring)
320	{
321	ring rr = NULL;
322	poly p = NULL;
323	mpsr_Status_t r;
324
325	if (currRing != cring)
326	{
327	rr = currRing;
328	mpsr_SetCurrRing(cring, TRUE);
329	}
330
331	if (!nIsZero(n))
332	{
333	p = pOne();
334	pSetCoeff(p, nCopy(n));
335	}
336	r = mpsr_PutPoly(link, p, cring);
337	pDelete(&p);
338
339	if (rr != NULL) mpsr_SetCurrRing(rr, TRUE);
340
341	return r;
342	}
343
344	mpsr_Status_t mpsr_PutPoly(MP_Link_pt link, poly p, ring cring)
345	{
346	mp_failr(MP_PutCommonOperatorPacket(link,
347	MP_PolyDict,
348	MP_CopPolyDenseDistPoly,
349	mpsr_GetNumOfRingAnnots(cring, 0),
350	pLength(p)));
351	failr(mpsr_PutRingAnnots(link, cring, 0));
352	return mpsr_PutPolyData(link, p, cring);
353	}
354
355
356	mpsr_Status_t mpsr_PutPolyVector(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,1),
362	pLength(p)));
363	failr(mpsr_PutRingAnnots(link, cring, 1));
364	return mpsr_PutPolyVectorData(link, p, cring);
365	}
366
367
368	mpsr_Status_t mpsr_PutIdeal(MP_Link_pt link, ideal id, ring cring)
369	{
370	int i, idn = IDELEMS(id);
371
372	mp_failr(MP_PutCommonOperatorPacket(link,
373	MP_PolyDict,
374	MP_CopPolyIdeal,
375	1,
376	idn));
377	mp_failr(MP_PutAnnotationPacket(link,
378	MP_ProtoDict,
379	MP_AnnotProtoPrototype,
380	MP_AnnotReqValNode));
381	mp_failr(MP_PutCommonMetaOperatorPacket(link,
382	MP_PolyDict,
383	MP_CopPolyDenseDistPoly,
384	mpsr_GetNumOfRingAnnots(cring, 0),
385	0));
386	failr(mpsr_PutRingAnnots(link, cring, 0));
387
388	for (i=0; i < idn; i++)
389	{
390	IMP_PutUint32(link, pLength(id->m[i]));
391	failr(mpsr_PutPolyData(link, id->m[i], cring));
392	}
393	return mpsr_Success;
394	}
395
396	mpsr_Status_t mpsr_PutModule(MP_Link_pt link, ideal id, ring cring)
397	{
398	int i, idn = IDELEMS(id);
399
400	mp_failr(MP_PutCommonOperatorPacket(link,
401	MP_PolyDict,
402	MP_CopPolyModule,
403	1,
404	idn));
405	mp_failr(MP_PutAnnotationPacket(link,
406	MP_ProtoDict,
407	MP_AnnotProtoPrototype,
408	MP_AnnotReqValNode));
409	mp_failr(MP_PutCommonMetaOperatorPacket(link,
410	MP_PolyDict,
411	MP_CopPolyDenseDistPoly,
412	mpsr_GetNumOfRingAnnots(cring, 1),
413	0));
414	failr(mpsr_PutRingAnnots(link, cring, 1));
415
416	for (i=0; i < idn; i++)
417	{
418	IMP_PutUint32(link, pLength(id->m[i]));
419	failr(mpsr_PutPolyVectorData(link, id->m[i], cring));
420	}
421	return mpsr_Success;
422	}
423
424	mpsr_Status_t mpsr_PutMatrix(MP_Link_pt link, ideal id, ring cring)
425	{
426	int nrows = id->nrows, ncols = id->ncols;
427	MP_Uint32_t n = nrows*ncols, i;
428
429	// First, we put the Matrix operator
430	mp_failr(MP_PutCommonOperatorPacket(link,
431	MP_MatrixDict,
432	MP_CopMatrixDenseMatrix,
433	2,
434	n));
435	// Put the two annotations
436	// First, the prototype annot
437	mp_failr(MP_PutAnnotationPacket(link,
438	MP_ProtoDict,
439	MP_AnnotProtoPrototype,
440	MP_AnnotReqValNode));
441	mp_failr(MP_PutCommonMetaOperatorPacket(link,
442	MP_PolyDict,
443	MP_CopPolyDenseDistPoly,
444	mpsr_GetNumOfRingAnnots(cring, 0),
445	0));
446	failr(mpsr_PutRingAnnots(link, cring, 0));
447
448	// second, the matrix dim annot
449	mp_failr(MP_PutAnnotationPacket(link,
450	MP_MatrixDict,
451	MP_AnnotMatrixDimension,
452	MP_AnnotReqValNode));
453	// which specifies the dimesnion of the matrix
454	mp_failr(MP_PutCommonOperatorPacket(link,
455	MP_BasicDict,
456	MP_CopBasicList,
457	0, 2));
458	mp_failr(MP_PutUint32Packet(link, (MP_Uint32_t) nrows, 0));
459	mp_failr(MP_PutUint32Packet(link, (MP_Uint32_t) ncols, 0));
460
461	// And finally, we put the elments
462	for (i=0; i < n; i++)
463	{
464	IMP_PutUint32(link, pLength(id->m[i]));
465	failr(mpsr_PutPolyData(link, id->m[i], cring));
466	}
467	return mpsr_Success;
468	}
469
470
471	// We communicate a map as an operator having three arguments: A ring,
472	// its name and an ideal
473	mpsr_Status_t mpsr_PutMap(MP_Link_pt link, map m, ring cring)
474	{
475	MP_Uint32_t i, idn = IDELEMS((ideal) m);
476	MP_DictTag_t dict;
477	MP_Common_t cop;
478
479	failr(mpsr_tok2mp(MAP_CMD, &dict, &cop));
480
481	mp_failr(MP_PutCommonOperatorPacket(link,
482	dict,
483	cop,
484	0,
485	3));
486	// First, is the ring
487	failr(mpsr_PutRingLeftv(link, (leftv) idroot->get(m->preimage, 1)));
488
489	// Second, the name of the ring
490	mp_failr(MP_PutStringPacket(link, m->preimage,0));
491
492	// and third, the ideal --
493	// supposing that we can cast a map to an ideal
494	return mpsr_PutIdeal(link, (ideal) m, cring);
495	}
496
497
498	/***************************************************************
499	*
500	* A routine which dumps the content of Singular to a file
501	*
502	***************************************************************/
503	mpsr_Status_t mpsr_PutDump(MP_Link_pt link)
504	{
505	idhdl h = idroot, h2 = NULL, rh = currRingHdl;
506	ring r;
507	sip_command cmd;
508	leftv lv;
509
510	mpsr_ClearError();
511	memset(&(cmd), 0, sizeof(sip_command));
512	cmd.argc = 2;
513	cmd.op = '=';
514	cmd.arg1.rtyp = DEF_CMD;
515	lv = mpsr_InitLeftv(COMMAND, (void *) &cmd);
516
517	MP_ResetLink(link);
518	while (h != NULL && h2 == NULL)
519	{
520
521	if (IDTYP(h) == PROC_CMD)
522	{
523	failr(mpsr_PutLeftv(link, (leftv) h, NULL));
524	#ifdef MPSR_DEBUG
525	Print("Dumped Proc %s\n", IDID(h));
526	#endif
527	}
528	else if (IDTYP(h) != LINK_CMD)
529	{
530	cmd.arg1.name = IDID(h);
531	memcpy(&(cmd.arg2), h, sizeof(sleftv));
532	if (mpsr_PutLeftv(link, lv , currRing) != mpsr_Success) break;
533	#ifdef MPSR_DEBUG
534	Print("Dumped %s\n", IDID(h));
535	#endif
536	if (IDTYP(h) == RING_CMD \|\| IDTYP(h) == QRING_CMD)
537	{
538	// we don't really need to do that, it's only for convenience
539	// for putting numbers
540	rSetHdl(h, TRUE);
541	r = IDRING(h);
542	h2 = r->idroot;
543	while (h2 != NULL)
544	{
545	cmd.arg1.name = IDID(h2);
546	memcpy(&(cmd.arg2), h2, sizeof(sleftv));
547	if (mpsr_PutLeftv(link, lv, r) != mpsr_Success) break;
548	#ifdef MPSR_DEBUG
549	Print("Dumped %s\n", IDID(h2));
550	#endif
551	h2 = h2->next;
552	}
553	}
554	}
555
556	h = h->next;
557	}
558	MP_EndMsg(link);
559	Free(lv, sizeof(sleftv));
560	if (rh != NULL && rh != currRingHdl) rSetHdl(rh, TRUE);
561
562	if (h == NULL && h2 == NULL)
563	return mpsr_Success;
564	else
565	return mpsr_Failure;
566	}
567
568	#endif // HAVE_MPSR
569
570

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

Download in other formats: