source: git/Singular/ipid.cc @ ad4bc9

spielwiese
Last change on this file since ad4bc9 was ad4bc9, checked in by Hans Schönemann <hannes@…>, 25 years ago
* hannes: Debugger-changes, typo fixes git-svn-id: file:///usr/local/Singular/svn/trunk@3028 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 21.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipid.cc,v 1.32 1999-05-06 16:53:24 Singular Exp $ */
5
6/*
7* ABSTRACT: identfier handling
8*/
9
10#include <string.h>
11
12#include "mod2.h"
13#include "tok.h"
14#include "ipshell.h"
15#include "intvec.h"
16#include "febase.h"
17#include "mmemory.h"
18#include "numbers.h"
19#include "polys.h"
20#include "ring.h"
21#include "ideals.h"
22#include "matpol.h"
23#include "lists.h"
24#include "attrib.h"
25#include "silink.h"
26#include "syz.h"
27#include "ipid.h"
28
29namehdl namespaceroot = NULL;
30#define TEST
31#ifndef HAVE_NAMESPACES
32idhdl idroot = NULL;
33#endif /* HAVE_NAMESPACES */
34idhdl currRingHdl = NULL;
35ring  currRing = NULL;
36ideal currQuotient = NULL;
37char* iiNoName="_";
38
39void paCleanUp(package pack);
40#ifdef HAVE_NAMESPACES
41BOOLEAN paKill(package pack, BOOLEAN force_top=FALSE);
42#endif
43
44/*0 implementation*/
45
46idhdl idrec::get(const char * s, int lev)
47{
48  idhdl h = this;
49  idhdl found=NULL;
50  int l;
51  char *id;
52  while (h!=NULL)
53  {
54    mmTestLP(IDID(h));
55// =============================================================
56#if 0
57// timings: ratchwum: 515 s, wilde13: 373 s, nepomuck: 267 s, lukas 863 s
58    id=IDID(h);
59    l=IDLEV(h);
60    if ((l==0) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
61    {
62      found=h;
63    }
64    else if ((l==lev) && (*(short *)s==*(short *)id) && (0 == strcmp(s+1,id+1)))
65    {
66      return h;
67    }
68#endif
69// =============================================================
70#if 0
71// timings: ratchwum: 515 s, wilde13: 398 s, nepomuck: 269 s, lukas 834 s
72    id=IDID(h);
73    if (*(short *)s==*(short *)id)
74    {
75      l=IDLEV(h);
76      if ((l==0) && (0 == strcmp(s+1,id+1)))
77      {
78        found=h;
79      }
80      else if ((l==lev) && (0 == strcmp(s+1,id+1)))
81      {
82        return h;
83      }
84    }
85#endif
86// =============================================================
87#if 1
88// timings: ratchwum: 501 s, wilde13: 357 s, nepomuck: 267 s, lukas 816 s
89    l=IDLEV(h);
90    if ((l==0)||(l==lev))
91    {
92      id=IDID(h);
93      if (*(short *)s==*(short *)id)
94      {
95        if (0 == strcmp(s+1,id+1))
96        {
97          if (l==lev) return h;
98          found=h;
99        }
100      }
101    }
102#endif
103// =============================================================
104    h = IDNEXT(h);
105  }
106  return found;
107}
108
109//idrec::~idrec()
110//{
111//  if (id!=NULL)
112//  {
113//    FreeL((ADDRESS)id);
114//    id=NULL;
115//  }
116//  /* much more !! */
117//}
118
119idhdl idrec::set(char * s, int lev, idtyp t, BOOLEAN init)
120{
121  //printf("define %s, %x, lev: %d, typ: %d\n", s,s,lev,t);
122  idhdl h = (idrec *)Alloc0(sizeof(idrec));
123  int   len = 0;
124  IDID(h)   = s;
125  IDTYP(h)  = t;
126  IDLEV(h)  = lev;
127#ifdef HAVE_NAMESPACES
128  h->ref    = 0;
129#endif /* HAVE_NAMESPACES */
130  IDNEXT(h) = this;
131  if (init)
132  {
133    switch (t)
134    {
135    //the type with init routines:
136      case INTVEC_CMD:
137      case INTMAT_CMD:
138        IDINTVEC(h) = new intvec();
139        break;
140      case NUMBER_CMD:
141        IDNUMBER(h) = nInit(0);
142        break;
143      case IDEAL_CMD:
144      case MODUL_CMD:
145        IDFLAG(h) = Sy_bit(FLAG_STD);
146      case MATRIX_CMD:
147        IDIDEAL(h) = idInit(1,1);
148        break;
149      case MAP_CMD:
150        IDIDEAL(h) = idInit(1,1);
151        IDMAP(h)->preimage = mstrdup(IDID(currRingHdl));
152        break;
153      case STRING_CMD:
154        IDSTRING(h) = mstrdup("");
155        break;
156      case LIST_CMD:
157        IDLIST(h)=(lists)Alloc(sizeof(slists));
158        IDLIST(h)->Init();
159        break;
160    //the types with the standard init: set the struct to zero
161      case LINK_CMD:
162        len=sizeof(ip_link);
163        break;
164      case RING_CMD:
165      case QRING_CMD:
166        len = sizeof(ip_sring);
167        break;
168      case PACKAGE_CMD:
169        len = sizeof(ip_package);
170        break;
171      case RESOLUTION_CMD:
172        len=sizeof(ssyStrategy);
173        break;
174      case PROC_CMD:
175        len=sizeof(procinfo);
176        break;
177    //other types: without init (int,script,poly,def,package)
178    }
179    if (len!=0)
180    {
181      IDSTRING(h) = (char *)Alloc0(len);
182    }
183    // additional settings:--------------------------------------
184    if (t == QRING_CMD)
185    {
186      IDRING(h)=rCopy(currRing);
187      /* QRING_CMD is ring dep => currRing !=NULL */
188    }
189    else if (t == PROC_CMD)
190    {
191      IDPROC(h)->language=LANG_NONE;
192    }
193    else if (t == PACKAGE_CMD)
194    {
195      IDPACKAGE(h)->language=LANG_NONE;
196      IDPACKAGE(h)->loaded = FALSE;
197    }
198
199  }
200  // --------------------------------------------------------
201  return  h;
202}
203
204//#define KAI
205idhdl enterid(char * s, int lev, idtyp t, idhdl* root, BOOLEAN init)
206{
207  idhdl h;
208  // is it the currRing - id ?
209#ifdef HAVE_NAMESPACES
210  namehdl topnsroot = namespaceroot->root;
211#endif
212  if ((currRingHdl!=NULL)
213  &&(IDLEV(currRingHdl)!=lev)
214  &&(s==IDID(currRingHdl)))
215  {
216    s=mstrdup(s);
217  }
218  // is it already defined in root ?
219  else if ((h=(*root)->get(s,lev))!=NULL)
220  {
221    if (IDLEV(h)!=lev)
222    {
223      s=mstrdup(s);
224    }
225    else if ((IDTYP(h) == t)||(t==DEF_CMD))
226    {
227      if (BVERBOSE(V_REDEFINE))
228#ifdef KAI
229        Warn("1 redefining %s **",s);
230#else
231        Warn("redefining %s **",s);
232#endif
233#ifdef HAVE_NAMESPACES
234        if(t==PACKAGE_CMD && strcmp(s,"Top")==0) {
235          Warn("identifier `%s` in use",s);
236          return(h);
237        }
238#endif /* HAVE_NAMESPACES */
239        if (s==IDID(h))
240        IDID(h)=NULL;
241      killhdl(h,root);
242    }
243    else
244      goto errlabel;
245  }
246  // is it already defined in idroot ?
247  else if (*root != IDROOT)
248  {
249    if ((h=IDROOT->get(s,lev))!=NULL)
250    {
251      if (IDLEV(h)!=lev)
252      {
253        s=mstrdup(s);
254      }
255      else if ((IDTYP(h) == t)||(t==DEF_CMD))
256      {
257        if (BVERBOSE(V_REDEFINE))
258#ifdef KAI
259          Warn("2 redefining %s **",s);
260#else
261          Warn("redefining %s **",s);
262#endif
263        IDID(h)=NULL;
264        killhdl(h,&IDROOT);
265      }
266      else
267      {
268        goto errlabel;
269      }
270    }
271  }
272#ifdef HAVE_NAMESPACES
273  // is it already defined in toplevel idroot ?
274  else if (*root != NSROOT(topnsroot))
275  {
276    if ((h=topnsroot->get(s,lev))!=NULL)
277    {
278        s=mstrdup(s);
279    }
280  }
281#endif /* HAVE_NAMESPACES */
282  // is it already defined in currRing->idroot ?
283  else if ((currRing!=NULL)&&((*root) != currRing->idroot))
284  {
285    if ((h=currRing->idroot->get(s,lev))!=NULL)
286    {
287      if (IDLEV(h)!=lev)
288      {
289        s=mstrdup(s);
290      }
291      else if ((IDTYP(h) == t)||(t==DEF_CMD))
292      {
293        if (BVERBOSE(V_REDEFINE))
294#ifdef KAI
295          Warn("3 redefining %s **",s);
296#else
297          Warn("redefining %s **",s);
298#endif
299        IDID(h)=NULL;
300        killhdl(h,&currRing->idroot);
301      }
302      else
303      {
304        goto errlabel;
305      }
306    }
307  }
308  return *root = (*root)->set(s, lev, t, init);
309
310  errlabel:
311    Werror("identifier `%s` in use",s);
312    return NULL;
313}
314
315void killid(char * id, idhdl * ih)
316{
317  if (id!=NULL)
318  {
319    idhdl h = (*ih)->get(id,myynest);
320
321    // id not found in global list, is it defined in current ring ?
322    if (h==NULL)
323    {
324      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
325      {
326        h = currRing->idroot->get(id,myynest);
327        if (h!=NULL)
328        {
329          killhdl(h,&(currRing->idroot));
330          return;
331        }
332      }
333      Werror("`%s` is not defined",id);
334      return;
335    }
336    killhdl(h,ih);
337  }
338  else
339    Werror("kill what ?");
340}
341
342void killhdl(idhdl h)
343{
344  int t=IDTYP(h);
345  if ((BEGIN_RING<t) && (t<END_RING) && (t!=QRING_CMD))
346    killhdl(h,&currRing->idroot);
347  else
348  {
349#ifdef HAVE_NAMESPACES
350    if(t==PACKAGE_CMD) {
351      killhdl(h,&NSROOT(namespaceroot->root));
352    } else
353#endif /* HAVE_NAMESPACES */
354    {
355      idhdl s=IDROOT;
356      while ((s!=h) && (s!=NULL)) s=s->next;
357      if (s==NULL) killhdl(h,&currRing->idroot);
358      else killhdl(h,&IDROOT);
359    }
360  }
361}
362
363void killhdl(idhdl h, idhdl * ih)
364{
365  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
366  idhdl hh;
367  BOOLEAN killOtherRing = TRUE;
368  BOOLEAN needResetRing = FALSE;
369
370  if (h->attribute!=NULL)
371  {
372    atKillAll(h);
373    //h->attribute=NULL;
374  }
375  // ring / qring  --------------------------------------------------------
376  if ((IDTYP(h) == RING_CMD) || (IDTYP(h) == QRING_CMD))
377  {
378    idhdl savecurrRingHdl = currRingHdl;
379    ring  savecurrRing = currRing;
380
381    // any objects defined for this ring ?
382    if (((IDTYP(h)==RING_CMD) && (IDRING(h)->ref<=0))
383    &&  (IDRING(h)->idroot!=NULL))
384    {
385      idhdl * hd = &IDRING(h)->idroot;
386      idhdl  hdh = IDNEXT(*hd);
387      idhdl  temp;
388      killOtherRing=(IDRING(h)!=currRing);
389      if (killOtherRing) //we are not killing the base ring, so switch
390      {
391        needResetRing=TRUE;
392        rSetHdl(h,FALSE);
393        /* no complete init*/
394      }
395      while (hdh!=NULL)
396      {
397        temp = IDNEXT(hdh);
398        killhdl(hdh,&(IDRING(h)->idroot));
399        hdh = temp;
400      }
401      killhdl(*hd,hd);
402    }
403    // reset currRing ?
404    if (needResetRing) // && (killOtherRing)
405    {
406      //we have to switch back to the base ring
407      //currRing = savecurrRing;
408      //currRingHdl = savecurrRingHdl;
409      if (savecurrRing!=NULL)
410      {
411        rSetHdl(savecurrRingHdl,TRUE);
412      }
413    }
414    rKill(h);
415  }
416#ifdef HAVE_NAMESPACES
417  // package -------------------------------------------------------------
418  else if (IDTYP(h) == PACKAGE_CMD)
419  {
420    if(IDPACKAGE(h)->language!=LANG_TOP)
421    {
422      if(!paKill(IDPACKAGE(h))) return;
423    }
424    else
425    {
426      if(strcmp(IDID(h), "Top")!=0)
427      {
428        if(!paKill(IDPACKAGE(h))) return;
429      }
430      else
431      {
432        if(!paKill(IDPACKAGE(h), TRUE)) return;
433      }
434    }
435  }
436  // pointer -------------------------------------------------------------
437  else if(IDTYP(h)==POINTER_CMD)
438  {
439    PrintS(">>>>>>Free pointer\n");
440  }
441#endif /* HAVE_NAMESPACES */
442  // poly / vector -------------------------------------------------------
443  else if ((IDTYP(h) == POLY_CMD) || (IDTYP(h) == VECTOR_CMD))
444  {
445    pDelete(&IDPOLY(h));
446  }
447  // ideal / module/ matrix / map ----------------------------------------
448  else if ((IDTYP(h) == IDEAL_CMD)
449           || (IDTYP(h) == MODUL_CMD)
450           || (IDTYP(h) == MATRIX_CMD)
451           || (IDTYP(h) == MAP_CMD))
452  {
453    ideal iid = IDIDEAL(h);
454    if (IDTYP(h) == MAP_CMD)
455    {
456      map im = IDMAP(h);
457      FreeL((ADDRESS)im->preimage);
458    }
459    idDelete(&iid);
460  }
461  // string -------------------------------------------------------------
462  else if (IDTYP(h) == STRING_CMD)
463  {
464    FreeL((ADDRESS)IDSTRING(h));
465    //IDSTRING(h)=NULL;
466  }
467  // proc ---------------------------------------------------------------
468  else if (IDTYP(h) == PROC_CMD)
469  {
470    piKill(IDPROC(h));
471  }
472  // number -------------------------------------------------------------
473  else if (IDTYP(h) == NUMBER_CMD)
474  {
475    nDelete(&IDNUMBER(h));
476  }
477  // intvec / intmat  ---------------------------------------------------
478  else if ((IDTYP(h) == INTVEC_CMD)||(IDTYP(h) == INTMAT_CMD))
479  {
480    delete IDINTVEC(h);
481  }
482  // list  -------------------------------------------------------------
483  else if (IDTYP(h)==LIST_CMD)
484  {
485    IDLIST(h)->Clean();
486    //Free((ADDRESS)IDLIST(h)->m, (IDLIST(h)->nr+1)*sizeof(sleftv));
487    //Free((ADDRESS)IDLIST(h), sizeof(slists));
488  }
489  // link  -------------------------------------------------------------
490  else if (IDTYP(h)==LINK_CMD)
491  {
492    slKill(IDLINK(h));
493  }
494  else if((IDTYP(h)==RESOLUTION_CMD)&&(IDDATA(h)!=NULL))
495  {
496    syKillComputation((syStrategy)IDDATA(h));
497  }
498#ifdef TEST
499  else if ((IDTYP(h)!= INT_CMD)&&(IDTYP(h)!=DEF_CMD))
500    Warn("unknown type to kill: %s(%d)",Tok2Cmdname(IDTYP(h)),IDTYP(h));
501#endif
502
503  //  general  -------------------------------------------------------------
504  // now dechain it and delete idrec
505#ifdef KAI_
506  if(h->next != NULL)
507    Print("=======>%s(%x) -> %s<====\n", IDID(h), IDID(h), IDID(h->next));
508  else
509    Print("=======>%s(%x)<====\n", IDID(h), IDID(h));
510#endif
511
512  FreeL((ADDRESS)IDID(h));
513  //IDID(h)=NULL;
514  if (h == (*ih))
515  {
516    // h is at the beginning of the list
517    *ih = IDNEXT(*ih);
518  }
519  else
520  {
521    // h is somethere in the list:
522    hh = *ih;
523    loop
524    {
525      idhdl hhh = IDNEXT(hh);
526      if (hhh == h)
527      {
528        IDNEXT(hh) = IDNEXT(hhh);
529        break;
530      }
531      hh = hhh;
532    }
533  }
534  Free((ADDRESS)h,sizeof(idrec));
535}
536
537idhdl ggetid(const char *n, BOOLEAN local, idhdl *packhdl)
538{
539#ifdef HAVE_NAMESPACES
540  idhdl h =namespaceroot->get(n,myynest, TRUE); // search in toplevel namespace
541  idhdl h2=namespaceroot->get(n,myynest); // search in current namespace
542  idhdl h3=NULL;
543  if ((currRing!=NULL) && ((h2==NULL)||(IDLEV(h2)!=myynest)))
544  {
545    h3 = currRing->idroot->get(n,myynest);
546  }
547  if (h3==NULL) {
548    if (h2!=NULL) {
549      *packhdl=namespaceroot->get(namespaceroot->name,0, TRUE);
550      return h2;
551    }
552    if(!local) {
553      if(h!=NULL)*packhdl=namespaceroot->get("Top",0, TRUE);
554      return h;
555    }
556  }
557  if(h3!=NULL) *packhdl = currRingHdl;
558  else *packhdl = NULL;
559  return h3;
560#else /* HAVE_NAMESPACES */
561  idhdl h = idroot->get(n,myynest);
562  idhdl h2=NULL;
563  *packhdl = NULL;
564  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
565  {
566    h2 = currRing->idroot->get(n,myynest);
567  }
568  if (h2==NULL) return h;
569  return h2;
570#endif /* HAVE_NAMESPACES */
571}
572
573idhdl ggetid(const char *n, BOOLEAN local)
574{
575#ifdef HAVE_NAMESPACES
576  idhdl h =namespaceroot->get(n,myynest, TRUE); // search in toplevel namespace
577  idhdl h2=namespaceroot->get(n,myynest); // search in current namespace
578  idhdl h3=NULL;
579  if ((currRing!=NULL) && ((h2==NULL)||(IDLEV(h2)!=myynest)))
580  {
581    h3 = currRing->idroot->get(n,myynest);
582  }
583  if (h3==NULL) {
584    if (h2!=NULL) return h2;
585    if(!local) return h;
586  }
587  return h3;
588#else /* HAVE_NAMESPACES */
589  idhdl h = idroot->get(n,myynest);
590  idhdl h2=NULL;
591  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
592  {
593    h2 = currRing->idroot->get(n,myynest);
594  }
595  if (h2==NULL) return h;
596  return h2;
597#endif /* HAVE_NAMESPACES */
598}
599
600void ipListFlag(idhdl h)
601{
602  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
603  if (hasFlag(h,FLAG_DRING)) PrintS(" (D)");
604}
605
606lists ipNameList(idhdl root)
607{
608  idhdl h=root;
609  /* compute the length */
610  int l=0;
611  while (h!=NULL) { l++; h=IDNEXT(h); }
612  /* allocate list */
613  lists L=(lists)Alloc(sizeof(slists));
614  L->Init(l);
615  /* copy names */
616  h=root;
617  l=0;
618  while (h!=NULL)
619  {
620    /* list is initialized with 0 => no need to clear anything */
621    L->m[l].rtyp=STRING_CMD;
622    L->m[l].data=mstrdup(IDID(h));
623    l++;
624    h=IDNEXT(h);
625  }
626  return L;
627}
628
629/*
630* move 'tomove' from root1 list to root2 list
631*/
632static void ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
633{
634  idhdl h;
635  /* search 'tomove' in root2 : if found -> do nothing */
636  h=root2;
637  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
638  if (h!=NULL) return;
639  /* search predecessor of h in root1, remove 'tomove' */
640  h=root1;
641  if (tomove==h)
642  {
643    root1=IDNEXT(h);
644  }
645  else
646  {
647    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
648    if (h==NULL) return; /* not in the list root1 -> do nothing */
649    IDNEXT(h)=IDNEXT(tomove);
650  }
651  /* add to root2 list */
652  IDNEXT(tomove)=root2;
653  root2=tomove;
654}
655
656void  ipMoveId(idhdl tomove)
657{
658  if ((currRing!=NULL)&&(tomove!=NULL))
659  {
660    if (((QRING_CMD!=IDTYP(tomove)) && (BEGIN_RING<IDTYP(tomove)) && (IDTYP(tomove)<END_RING))
661    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
662    {
663      /*move 'tomove' to ring id's*/
664      ipSwapId(tomove,IDROOT,currRing->idroot);
665    }
666    else
667    {
668      /*move 'tomove' to global id's*/
669      ipSwapId(tomove,currRing->idroot,IDROOT);
670    }
671  }
672}
673
674char * piProcinfo(procinfov pi, char *request)
675{
676  if(pi == NULL) return "empty proc";
677  else if (strcmp(request, "libname")  == 0) return pi->libname;
678  else if (strcmp(request, "procname") == 0) return pi->procname;
679  else if (strcmp(request, "type")     == 0) {
680    switch (pi->language) {
681      case LANG_SINGULAR: return "singular"; break;
682      case LANG_C:        return "object";   break;
683      case LANG_NONE:     return "none";     break;
684      default:            return "unknow language";
685    }
686  } else if (strcmp(request, "ref")      == 0) {
687    char p[8];
688    sprintf(p, "%d", pi->ref);
689    return mstrdup(p);  // MEMORY-LEAK
690  }
691  return "??";
692}
693
694void piCleanUp(procinfov pi)
695{
696  (pi->ref)--;
697  if (pi->ref <= 0)
698  {
699    FreeL((ADDRESS)pi->libname);
700    FreeL((ADDRESS)pi->procname);
701    if( pi->language == LANG_SINGULAR)
702    {
703      FreeL((ADDRESS)pi->data.s.body);
704    }
705    if( pi->language == LANG_C)
706    {
707    }
708    memset((void *) pi, 0, sizeof(procinfo));
709    pi->language=LANG_NONE;
710  }
711}
712
713void piKill(procinfov pi)
714{
715  piCleanUp(pi);
716  if (pi->ref <= 0)
717    Free((ADDRESS)pi, sizeof(procinfo));
718}
719
720void paCleanUp(package pack)
721{
722  (pack->ref)--;
723  if (pack->ref < 0)
724  {
725    if( pack->language == LANG_C)
726    {
727      Print("//dlclose(%s)\n",pack->libname);
728#ifdef HAVE_DYNAMIC_LOADING
729      extern int dynl_close (void *handle);
730      dynl_close (pack->handle);
731#endif /* HAVE_DYNAMIC_LOADING */
732    }
733    FreeL((ADDRESS)pack->libname);
734    memset((void *) pack, 0, sizeof(sip_package));
735    pack->language=LANG_NONE;
736  }
737}
738
739#ifdef HAVE_NAMESPACES
740BOOLEAN paKill(package pack, BOOLEAN force_top)
741{
742  if (pack->ref <= 0 || force_top) {
743    idhdl hdh = pack->idroot;
744    idhdl temp;
745    while (hdh!=NULL)
746    {
747      temp = IDNEXT(hdh);
748      if((IDTYP(hdh)!=PACKAGE_CMD) ||
749         (IDTYP(hdh)==PACKAGE_CMD && IDPACKAGE(hdh)->language!=LANG_TOP) ||
750         (IDTYP(hdh)==PACKAGE_CMD && IDPACKAGE(hdh)->language==LANG_TOP &&
751         IDPACKAGE(hdh)->ref>0 ))
752        killhdl(hdh,&(pack->idroot));
753      hdh = temp;
754    }
755    if(checkPackage(pack)) {
756      paCleanUp(pack);
757      Free((ADDRESS)pack, sizeof(sip_package));
758    } else return FALSE;
759  } else paCleanUp(pack);
760  return TRUE;
761}
762#endif /* HAVE_NAMESPACES */
763
764char *idhdl2id(idhdl pck, idhdl h)
765{
766  char *name = (char *)AllocL(strlen(pck->id) + strlen(h->id) + 3);
767  sprintf(name, "%s::%s", pck->id, h->id);
768  return(name);
769}
770
771void iiname2hdl(const char *name, idhdl *pck, idhdl *h)
772{
773  const char *q = strchr(name, ':');
774  char *p, *i;
775
776  if(q==NULL)
777  {
778    p = mstrdup("");
779    i = (char *)AllocL(strlen(name)+1);
780    *i = '\0';
781    sscanf(name, "%s", i);
782#ifdef HAVE_NAMESPACES
783    *h = namespaceroot->get(i, myynest);
784    if(*h == NULL) { *h = namespaceroot->get(i, myynest, TRUE); }
785#else /* HAVE_NAMESPACES */
786#endif /* HAVE_NAMESPACES */
787  }
788  else {
789    if( *(q+1) != ':') return;
790    i = (char *)AllocL(strlen(name)+1);
791    *i = '\0';
792    if(name == q)
793    {
794      p = mstrdup("");
795      sscanf(name, "::%s", i);
796#ifdef HAVE_NAMESPACES
797      *h =namespaceroot->get(i, myynest, TRUE); // search in toplevel namespace
798#else /* HAVE_NAMESPACES */
799#endif /* HAVE_NAMESPACES */
800    }
801    else
802    {
803      p = (char *)AllocL(strlen(name)+1);
804      sscanf(name, "%[^:]::%s", p, i);
805#ifdef HAVE_NAMESPACES
806      *pck =namespaceroot->get(p, myynest, TRUE); // search in toplevel namespace
807      namespaceroot->push(IDPACKAGE(*pck), IDID(*pck));
808      *h =namespaceroot->get(i, myynest); // search in toplevel namespace
809      namespaceroot->pop();
810#else /* HAVE_NAMESPACES */
811#endif /* HAVE_NAMESPACES */
812    }
813  }
814  //printf("Package: '%s'\n", p);
815  //printf("Id Rec : '%s'\n", i);
816  FreeL(p);
817  FreeL(i);
818}
819
820#if 0
821char *getnamelev()
822{
823  char buf[256];
824  sprintf(buf, "(%s:%d)", namespaceroot->name,namespaceroot->lev);
825  return(buf);
826}
827// warning: address of local variable `buf' returned
828#endif
829
830namehdl namerec::push(package pack, char *name, int nesting, BOOLEAN init)
831{
832  //printf("PUSH: put entry (%s) on stack\n", name);
833  namehdl ns = (namerec *)Alloc0(sizeof(namerec));
834  extern int myynest;
835  if(nesting<0) nesting = myynest;
836  ns->next   = this;
837  if(this==NULL && !init)
838  {
839    printf("PUSH: this is NULL and init not set.\n");
840    init=TRUE;
841  }
842  if(init)
843  {
844    ns->next    = NULL;
845#ifdef HAVE_NAMESPACES
846    ns->pack    = (ip_package *)Alloc0(sizeof(ip_package));
847#endif /* HAVE_NAMESPACES */
848    ns->isroot  = TRUE;
849    ns->lev     = 1;
850    //ns->myynest = 0;
851  }
852  else
853  {
854    extern ring currRing;
855#ifdef HAVE_NAMESPACES
856    ns->pack   = pack;
857#endif /* HAVE_NAMESPACES */
858    ns->lev    = this->lev+1;
859    //ns->myynest = myynest+1;
860    this->currRing = currRing;
861    //printf("Saving Ring %x, %x\n", this->currRing, currRing);
862  }
863  ns->name    = mstrdup(name);
864  ns->myynest = nesting;
865
866  //ns->currRing = currRing;
867  //ns->currRingHdl = currRingHdl;
868  if(ns->isroot) ns->root=ns; else ns->root = this->root;
869  namespaceroot = ns;
870#if 0
871  if(init && ns->isroot) {
872    idhdl pl = enterid( mstrdup("Top"),0, PACKAGE_CMD,
873                      &NSROOT(namespaceroot), TRUE );
874    if(pl != NULL) {
875      Free((ADDRESS)IDPACKAGE(pl), sizeof(ip_package));
876      IDPACKAGE(pl) = ns->pack;
877    }
878  }
879#endif
880  //Print("NSPUSH: done\n");
881  return(namespaceroot);
882}
883
884namehdl namerec::pop(BOOLEAN change_nesting)
885{
886  namehdl ns;
887  //printf("POP: remove entry (%s)\n", this->name);
888  if(this==NULL) return NULL;
889  if(isroot) {
890    //printf("POP: base. woul'd do it.\n");
891    return this;
892  }
893  if(!change_nesting && this->myynest!=this->next->myynest) {
894    return(this);
895  }
896  ns = this;
897  namespaceroot = this->next;
898  FreeL((ADDRESS)ns->name);
899  Free((ADDRESS)ns, sizeof(namerec));
900  return(namespaceroot);
901}
902
903#ifdef HAVE_NAMESPACES
904idhdl namerec::get(const char * s, int lev, BOOLEAN root)
905{
906  namehdl ns;
907  if(root) {
908    ns = this->root;
909  } else {
910    ns = this;
911  }
912  //printf("//====== namerec::get(%s, %d) from '%s'\n", s, lev, ns->name);
913  if(ns==NULL) {
914    //printf("//======== namerec::get() from null\n");
915    return NULL;
916  }
917  return( NSROOT(ns)->get(s, lev));
918}
919
920BOOLEAN checkPackage(package pack)
921{
922  namehdl nshdl = namespaceroot;
923
924  for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
925    //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
926    if (nshdl->pack==pack)
927    {
928      Warn("package '%s' still in use on level %d",nshdl->name, nshdl->lev);
929      return FALSE;
930    }
931  }
932  if (nshdl->pack==pack)
933  {
934    //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
935    Warn("package '%s' still in use on level %d",nshdl->name, nshdl->lev);
936    return FALSE;
937  }
938  return TRUE;
939
940}
941#endif /* HAVE_NAMESPACES */
Note: See TracBrowser for help on using the repository browser.