source: git/Singular/mpsr_GetMisc.cc @ 6ce030f

jengelh-datetimespielwiese
Last change on this file since 6ce030f was 6ce030f, checked in by Oleksandr Motsak <motsak@…>, 11 years ago
removal of the $Id$ svn tag from everywhere NOTE: the git SHA1 may be used instead (only on special places) NOTE: the libraries Singular/LIB/*.lib still contain the marker due to our current use of svn
  • Property mode set to 100644
File size: 10.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/***************************************************************
6 *
7 * File:       mpsr_GetMisc.cc
8 * Purpose:    Miscellanous routines which are needed by mpsr_Get
9 * Author:     Olaf Bachmann (10/95)
10 *
11 * Change History (most recent first):
12 *
13 ***************************************************************/
14
15#include "config.h"
16#include <kernel/mod2.h>
17
18#ifdef HAVE_MPSR
19
20#include <Singular/mpsr_Get.h>
21//#include "kernel/longalg.h"
22#include <Singular/tok.h>
23#include <polys/monomials/maps.h>
24#include <Singular/lists.h>
25
26BOOLEAN currComplete = FALSE;
27
28static ring mpsr_rDefault(short ch, const 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, const 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 = mpsr_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 mpsr_rDefault(ch, MPSR_DEFAULT_VARNAME);
70}
71
72static ring mpsr_rDefault(short ch, const char *name)
73{
74  ring r = (ring) omAlloc0Bin(sip_sring_bin);
75  r->ch = ch;
76  r->N = 1;
77  r->names = (char **) omAlloc0Bin(char_ptr_bin);
78  r->names[0] = omStrDup(name);
79
80  r->wvhdl = (int **)omAlloc0(3 * sizeof(int *));
81  /*order: dp,C,0*/
82  r->order = (int *) omAlloc(3 * sizeof(int *));
83  r->block0 = (int *)omAlloc(3 * sizeof(int *));
84  r->block1 = (int *)omAlloc(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
104static inline 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          p_Delete(&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 *) omAlloc(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          omFreeSize(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          nMapFunc nMap=nSetMap(from_ring);
270          l->data = (void *) nMap(nn);
271          mpsr_SetCurrRing(from_ring, FALSE);
272          nDelete(&nn);
273        }
274    }
275    l = l->next;
276  }
277}
278
279
280// searches for a ring handle which has a ring which is equal to r
281// if one is found, then this one is set to the new global ring
282// otherwise, a ring name is generated, and a new idhdl is created
283void mpsr_SetCurrRingHdl(mpsr_leftv mlv)
284{
285  idhdl h = IDROOT, rh = NULL;
286  ring r = mlv->r;
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    // reset debug field so that RingOfLm does not complain
318    // this does nothing on !PDEBUG
319    p_SetRingOfLeftv(mlv->lv, IDRING(rh));
320
321    rSetHdl(rh);
322
323    if (currRing != r)
324    {
325      mpsr_assume(r->ref <= 0);
326      rKill(r);
327    }
328  }
329  else
330  {
331    rh = mpsr_InitIdhdl((r->qideal == NULL ? (short) RING_CMD
332                         : (short) QRING_CMD),
333                        (void *) r, GenerateRingName());
334    // reset currRing for reasons explained above
335    if (currRingHdl != NULL) mpsr_SetCurrRing(IDRING(currRingHdl), TRUE);
336    rSetHdl(rh);
337    rh->next = IDROOT;
338    IDROOT = rh;
339    r->ref = 0;
340  }
341}
342
343
344static int gringcounter = 0;
345static char grname[14];
346
347static char* GenerateRingName()
348{
349  sprintf(grname, "mpsr_r%d", gringcounter++);
350  return grname;
351}
352
353// searches through the Singular namespace for a matching name:
354// the first found is returned together witht the respective ring
355idhdl mpsr_FindIdhdl(char *name, ring &r)
356{
357  idhdl h = (IDROOT != NULL ? IDROOT->get(name, 0): (idhdl) NULL), h2;
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      omFreeBin(mlv->lv, sleftv_bin);
404    }
405    if (mlv->r != NULL) rKill(mlv->r);
406  }
407  omFreeBin(mlv, mpsr_sleftv_bin);
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) omAlloc0Bin(mpsr_sleftv_bin);
418    dlv->r = rCopy(slv->r);
419    dlv->lv = (leftv) omAlloc0Bin(sleftv_bin);
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#undef malloc
435#undef free
436#undef freeSize
437
438#include "mmalloc.h"
439
440static int mpsr_is_initialized = 0;
441
442LINKAGE void mpsr_Init()
443{
444  if (mpsr_is_initialized) return;
445  // memory management functions of MP (and MPT)
446#if defined(OMALLOC_USES_MALLOC) || defined(X_OMALLOC)
447  IMP_RawMemAllocFnc = omMallocFunc;
448  IMP_RawMemFreeFnc = omFreeFunc;
449  IMP_MemAllocFnc = omMallocFunc;
450  IMP_MemFreeFnc = omFreeSizeFunc;
451#else
452  IMP_RawMemAllocFnc = malloc;
453  IMP_RawMemFreeFnc = free;
454  IMP_MemAllocFnc = malloc;
455  IMP_MemFreeFnc = freeSize;
456#endif
457
458  // Init of the MPT External Data functions
459  MPT_GetExternalData = mpsr_GetExternalData;
460  MPT_DeleteExternalData = mpsr_DeleteExternalData;
461
462#ifdef  PARI_BIGINT_TEST
463  init(4000000, 2);
464#endif
465}
466
467#ifdef MPSR_DEBUG
468// this is just a dummy function, where we can set a debugger breakpoint
469void mpsr_Break()
470{
471  Werror("mpsr_Error");
472}
473#endif
474
475#endif // HAVE_MPSR
Note: See TracBrowser for help on using the repository browser.