source: git/Singular/mpsr_GetMisc.cc @ 63374c

spielwiese
Last change on this file since 63374c was 63374c, checked in by Olaf Bachmann <obachman@…>, 25 years ago
* moved mpsr_RingEqual to rEqual * controled access to qideal in qrings git-svn-id: file:///usr/local/Singular/svn/trunk@3253 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 11.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: mpsr_GetMisc.cc,v 1.15 1999-07-09 14:06:48 obachman Exp $ */
5
6/***************************************************************
7 *
8 * File:       mpsr_GetMisc.cc
9 * Purpose:    Miscellanous routines which are needed by mpsr_Get
10 * Author:     Olaf Bachmann (10/95)
11 *
12 * Change History (most recent first):
13 *
14 ***************************************************************/
15
16#include "mod2.h"
17
18#ifdef HAVE_MPSR
19
20#include "mpsr_Get.h"
21#include "longalg.h"
22#include "tok.h"
23#include "maps.h"
24#include "lists.h"
25
26BOOLEAN currComplete = FALSE;
27
28static ring rDefault(short ch, char *name);
29static char* GenerateRingName();
30
31
32// use the varname so that they are compatible with the ones generated
33// by GetRingAnnots
34#define MPSR_DEFAULT_VARNAME "x(1)"
35
36// returns some default ring
37int mpsr_rDefault(short ch, char *name, ring &r)
38{
39  // check for currRing
40  if (currRing != NULL && rInternalChar(currRing) == ch)
41  // orig: currRing->ch==ch ???
42  {
43    int i, n = currRing->N;
44    char **names = currRing->names;
45
46    for (i=0; i<n; i++)
47    {
48      if (strcmp(names[i], name) == 0)
49      {
50        (currRing->ref)++;
51        r = currRing;
52        return i;
53      }
54    }
55  }
56  r = rDefault(ch, name);
57  return 0;
58}
59
60ring mpsr_rDefault(short ch)
61{
62  if (currRing != NULL && rInternalChar(currRing) == ch)
63  // orig: currRing->ch==ch ???
64  {
65    (currRing->ref)++;
66    return currRing;
67  }
68  else
69    return rDefault(ch, MPSR_DEFAULT_VARNAME);
70}
71
72static ring rDefault(short ch, char *name)
73{
74  ring r = (ring) Alloc0(sizeof(sip_sring));
75  r->ch = ch;
76  r->N = 1;
77  r->names = (char **) Alloc(sizeof(char *));
78  r->names[0] = mstrdup(name);
79
80  r->wvhdl = (short **)Alloc0(3 * sizeof(short *));
81  /*order: dp,C,0*/
82  r->order = (int *) Alloc(3 * sizeof(int *));
83  r->block0 = (int *)Alloc(3 * sizeof(int *));
84  r->block1 = (int *)Alloc(3 * sizeof(int *));
85  /* ringorder dp for the first block: var 1..3 */
86  r->order[0]  = ringorder_unspec;
87  r->block0[0] = 1;
88  r->block1[0] = 1;
89  /* ringorder C for the second block: no vars */
90  r->order[1]  = ringorder_C;
91  r->block0[1] = 0;
92  r->block1[1] = 0;
93  /* the last block: everything is 0 */
94  r->order[2]  = 0;
95  r->block0[2] = 0;
96  r->block1[2] = 0;
97  rComplete(r);
98  return r;
99}
100
101// returns TRUE, if r1 less or equals r2
102// FALSE, otherwise
103// Less or equal means that r1 is a strong subring of r2
104inline BOOLEAN RingLessEqual(ring r1, ring r2)
105{
106  int i, j;
107
108  if (r1 == r2) return 1;
109
110  if (r1 == NULL) return 1;
111
112  if (r2 == NULL) return 0;
113
114  if ((r1->N > r2->N) || (r1->OrdSgn != r2->OrdSgn) || (rPar(r1) > rPar(r2)))
115    return 0;
116
117  if (!rField_is_Q(r1) && rInternalChar(r1) != rInternalChar(r2)) return 0;
118  // orig: if (r1->ch != 0 && r1->ch != r2->ch) return 0;
119
120  for (i=0, j=0; j<r1->N && i<r2->N; i++)
121    if (strcmp(r1->names[j], r2->names[i]) == 0) j++;
122  if (j < r1->N) return 0;
123
124  // for ordering, suppose that they are only simple orderings
125  if (r1->order[2] != 0 || r2->order[2] != 0 ||
126      (r1->order[0] != r2->order[0] && r1->order[0] != ringorder_unspec) ||
127      r1->order[1] != r2->order[1])
128    return 0;
129
130  for (i=0; i<rPar(r1);i++)
131  {
132      if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
133        return 0;
134  }
135  // r1->parameter == NULL && r2->parameter != NULL  is ok
136
137  if (r1->minpoly != NULL)
138  {
139    if (r2->minpoly == NULL) return 0;
140    mpsr_SetCurrRing(r1, FALSE);
141    if (! naEqual(r1->minpoly, r2->minpoly)) return 0;
142  }
143  return 1;
144}
145
146// returns MP_Success and lv2 appended to lv1, both over the same ring,
147// or MP_Failure
148mpsr_Status_t mpsr_MergeLeftv(mpsr_leftv mlv1, mpsr_leftv mlv2)
149{
150  ring r, r1 = mlv1->r, r2 = mlv2->r;
151  leftv lv;
152
153  if (rEqual(r1,r2))
154  {
155    if (r2 != NULL) rKill(r2);
156    r = r1;
157  }
158  else if (RingLessEqual(r1, r2))
159  {
160    r = r2;
161    if (r1 != NULL)
162    {
163      mpsr_MapLeftv(mlv1->lv, r1, r);
164      rKill(r1);
165    }
166  }
167  else if (RingLessEqual(r2, r1))
168  {
169    r = r1;
170    if (r2 != NULL)
171    {
172      mpsr_MapLeftv(mlv2->lv, r2, r);
173      rKill(r2);
174    }
175  }
176  else if (rSum(r1, r2, r) >= 0)
177  {
178    mpsr_MapLeftv(mlv1->lv, r1, r);
179    mpsr_MapLeftv(mlv2->lv, r2, r);
180    rKill(r1);
181    rKill(r2);
182  }
183  else return mpsr_Failure;
184
185  lv = mlv1->lv;
186  while (lv->next != NULL) lv = lv->next;
187
188  lv->next = mlv2->lv;
189  mlv1->r = r;
190
191#ifdef RDEBUG
192  if (r!= NULL) rTest(r);
193#endif
194  // this is an optimization for the mpsr_rDefault routines
195  currRing = r;
196  return mpsr_Success;
197}
198
199void mpsr_MapLeftv(leftv l, ring from_ring, ring to_ring)
200{
201  int i, n;
202
203  while (l != NULL)
204  {
205    short typ = l->Typ();
206
207    switch(typ)
208    {
209        case POLY_CMD:
210        case VECTOR_CMD:
211        {
212          poly p = (poly) l->data;
213          mpsr_SetCurrRing(to_ring, TRUE);
214          l->data = (void *) maIMap(from_ring, (poly) l->data);
215          ppDelete(&p, from_ring);
216          break;
217        }
218
219        case MODUL_CMD:
220        case IDEAL_CMD:
221        case MATRIX_CMD:
222        case MAP_CMD:
223        {
224          ideal id = (ideal) l->Data();
225          n = IDELEMS(id);
226          poly *m = id->m, *m1 = (poly *) Alloc(n*sizeof(poly));
227          mpsr_SetCurrRing(to_ring, TRUE);
228          for (i=0; i<n; i++)
229          {
230            m1[i] = m[i];
231            m[i] = maIMap(from_ring, m[i]);
232          }
233          mpsr_SetCurrRing(from_ring, FALSE);
234          for (i=0; i<n; i++) pDelete(&(m1[i]));
235          Free(m1, n*sizeof(poly));
236          break;
237        }
238
239        case LIST_CMD:
240        {
241          lists ll = (lists) l->Data();
242          n = ll->nr + 1;
243          for (i=0; i<n; i++) mpsr_MapLeftv(&(ll->m[i]), from_ring, to_ring);
244          break;
245        }
246
247        case COMMAND:
248        {
249          command cmd = (command) l->Data();
250          if (cmd->op == PROC_CMD && cmd->argc == 2)
251            mpsr_MapLeftv(&(cmd->arg2), from_ring, to_ring);
252          else if (cmd->argc > 0)
253          {
254            mpsr_MapLeftv(&(cmd->arg1), from_ring, to_ring);
255            if (cmd->argc > 1)
256            {
257              mpsr_MapLeftv(&(cmd->arg2), from_ring, to_ring);
258              if (cmd->argc > 2)
259                mpsr_MapLeftv(&(cmd->arg3), from_ring, to_ring);
260            }
261          }
262          break;
263        }
264
265        case NUMBER_CMD:
266        {
267          number nn = (number) l->data;
268          mpsr_SetCurrRing(to_ring, TRUE);
269          nSetMap(rInternalChar(from_ring), from_ring->parameter,
270            rPar(from_ring), from_ring->minpoly);
271          l->data = (void *) nMap(nn);
272          mpsr_SetCurrRing(from_ring, FALSE);
273          nDelete(&nn);
274        }
275    }
276    l = l->next;
277  }
278}
279
280
281// searches for a ring handle which has a ring which is equal to r
282// if one is found, then this one is set to the new global ring
283// otherwise, a ring name is generated, and a new idhdl is created
284void mpsr_SetCurrRingHdl(ring r)
285{
286  idhdl h = IDROOT, rh = NULL;
287
288  if (r == NULL)
289  {
290    if (currRingHdl != NULL && currRing != IDRING(currRingHdl))
291      mpsr_SetCurrRing(IDRING(currRingHdl), TRUE);
292    return;
293  }
294
295  rTest(r);
296  // try to find an idhdl which is an equal ring
297  while (h != NULL)
298  {
299    if ((IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD) &&
300        (rEqual(IDRING(h), r)))
301    {
302      // found one
303      rh = h;
304      break;
305    }
306    h = h->next;
307  }
308
309  if (rh != NULL)
310  {
311    // found an idhdl to an equal ring
312    // we better reset currRing, so that rSetHdl does not choke (see
313    // sLastPrinted)
314    if (currRingHdl != NULL && IDRING(currRingHdl) != currRing)
315      mpsr_SetCurrRing(IDRING(currRingHdl), TRUE);
316
317    rSetHdl(rh, TRUE);
318
319    if (currRing != r)
320    {
321      mpsr_assume(r->ref <= 0);
322      rKill(r);
323    }
324  }
325  else
326  {
327    rh = mpsr_InitIdhdl((r->qideal == NULL ? (short) RING_CMD
328                         : (short) QRING_CMD),
329                        (void *) r, GenerateRingName());
330    // reset currRing for reasons explained above
331    if (currRingHdl != NULL) mpsr_SetCurrRing(IDRING(currRingHdl), TRUE);
332    rSetHdl(rh, TRUE);
333    rh->next = IDROOT;
334    IDROOT = rh;
335    r->ref = 0;
336  }
337}
338
339
340int gringcounter = 0;
341char grname[14];
342
343static char* GenerateRingName()
344{
345  sprintf(grname, "mpsr_r%d", gringcounter++);
346  return grname;
347}
348
349// searches through the Singular namespace for a matching name:
350// the first found is returned together witht the respective ring
351idhdl mpsr_FindIdhdl(char *name, ring &r)
352{
353#ifdef HAVE_NAMESPACES
354  idhdl h = (NSROOT(namespaceroot) != NULL ? namespaceroot->get(name, 0): (idhdl) NULL), h2;
355#else /* HAVE_NAMESPACES */
356  idhdl h = (idroot != NULL ? idroot->get(name, 0): (idhdl) NULL), h2;
357#endif /* HAVE_NAMESPACES */
358  r = NULL;
359
360  if (h != NULL)
361  {
362    r = NULL;
363    return h;
364  }
365
366  h = IDROOT;
367  while ( h != NULL)
368  {
369    if (IDTYP(h) == RING_CMD || IDTYP(h) == QRING_CMD)
370    {
371      h2 = (IDRING(h)->idroot!=NULL ?IDRING(h)->idroot->get(name, 0) :
372            (idhdl) NULL);
373
374      if (h2 != NULL)
375      {
376        r = IDRING(h);
377        r->ref++;
378        return h2;
379      }
380    }
381    h = h->next;
382  }
383  return NULL;
384}
385
386
387/***************************************************************
388 *
389 * Stuff which deals with External Data
390 *
391 ***************************************************************/
392
393void mpsr_DeleteExternalData(MPT_ExternalData_t edata)
394{
395  mpsr_leftv mlv = (mpsr_leftv) edata;
396
397  if (edata != NULL)
398  {
399    if (mlv->r != NULL) mpsr_SetCurrRing(mlv->r, FALSE);
400    if (mlv->lv != NULL)
401    {
402      mlv->lv->CleanUp();
403      Free(mlv->lv, sizeof(sleftv));
404    }
405    if (mlv->r != NULL) rKill(mlv->r);
406  }
407  Free(mlv, sizeof(mpsr_sleftv));
408}
409
410void mpsr_CopyExternalData(MPT_ExternalData_t *dest,
411                           MPT_ExternalData_t src)
412{
413  mpsr_leftv slv = (mpsr_leftv) src, dlv;
414
415  if (slv != NULL)
416  {
417    dlv = (mpsr_leftv) Alloc0(sizeof(mpsr_sleftv));
418    dlv->r = rCopy(slv->r);
419    dlv->lv = (leftv) Alloc0(sizeof(sleftv));
420    if (slv->lv != NULL) dlv->lv->Copy(slv->lv);
421    else dlv->lv = NULL;
422
423    *dest = (MPT_ExternalData_t) dlv;
424  }
425  else
426    *dest = NULL;
427}
428
429/***************************************************************
430 *
431 * mpsr initialization
432 *
433 ***************************************************************/
434
435#ifdef MDEBUG
436void * mpAllocBlock( size_t t)
437{
438  return mmDBAllocBlock(t,"mp",0);
439}
440void mpFreeBlock( void* a, size_t t)
441{
442  mmDBFreeBlock(a,t,"mp",0);
443}
444
445void * mpAlloc( size_t t)
446{
447  return mmDBAlloc(t,"mp",0);
448}
449void mpFree(void* a)
450{
451  mmDBFree(a,"mp",0);
452}
453#endif
454
455void mpsr_Init()
456{
457#ifndef EXTERNAL_MALLOC_H
458  // memory management functions of MP (and MPT)
459#ifndef MDEBUG
460  IMP_RawMemAllocFnc = mmAlloc;
461  IMP_RawMemFreeFnc = mmFree;
462  IMP_MemAllocFnc = mmAllocBlock;
463  IMP_MemFreeFnc = mmFreeBlock;
464#else
465  IMP_RawMemAllocFnc = mpAlloc;
466  IMP_RawMemFreeFnc = mpFree;
467  IMP_MemAllocFnc = mpAllocBlock;
468  IMP_MemFreeFnc = mpFreeBlock;
469#endif
470#endif
471
472  // Init of the MPT External Data functions
473  MPT_GetExternalData = mpsr_GetExternalData;
474  MPT_DeleteExternalData = mpsr_DeleteExternalData;
475
476#ifdef  PARI_BIGINT_TEST
477  init(4000000, 2);
478#endif
479}
480
481#ifdef MPSR_DEBUG
482// this is just a dummy function, where we can set a debugger breakpoint
483void mpsr_Break()
484{
485  Werror("mpsr_Error");
486}
487#endif
488
489#endif // HAVE_MPSR
Note: See TracBrowser for help on using the repository browser.