source: git/Singular/ipid.cc @ 561cbf

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