source: git/Singular/ipid.cc @ befd80d

spielwiese
Last change on this file since befd80d was befd80d, checked in by Hans Schoenemann <hannes@…>, 5 years ago
opt: iiS2I
  • Property mode set to 100644
File size: 19.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: identfier handling
7*/
8
9
10
11
12
13#include "kernel/mod2.h"
14
15#include "misc/options.h"
16#include "misc/intvec.h"
17
18#include "coeffs/numbers.h"
19#include "coeffs/bigintmat.h"
20
21#include "polys/matpol.h"
22#include "polys/monomials/ring.h"
23
24#include "kernel/polys.h"
25#include "kernel/ideals.h"
26#include "kernel/GBEngine/syz.h"
27
28#include "Singular/tok.h"
29#include "Singular/ipshell.h"
30#include "Singular/fevoices.h"
31#include "Singular/lists.h"
32#include "Singular/attrib.h"
33#include "Singular/links/silink.h"
34#include "Singular/ipid.h"
35#include "Singular/blackbox.h"
36#include "Singular/number2.h"
37
38#ifdef SINGULAR_4_2
39#include "Singular/number2.h"
40#endif
41#ifdef HAVE_DYNAMIC_LOADING
42#include "polys/mod_raw.h"
43#endif /* HAVE_DYNAMIC_LOADING */
44
45VAR omBin sip_command_bin = omGetSpecBin(sizeof(sip_command));
46VAR omBin sip_package_bin = omGetSpecBin(sizeof(sip_package));
47//omBin ip_package_bin = omGetSpecBin(sizeof(ip_package));
48VAR omBin idrec_bin = omGetSpecBin(sizeof(idrec));
49
50VAR coeffs coeffs_BIGINT;
51
52VAR proclevel *procstack=NULL;
53//idhdl idroot = NULL;
54
55VAR idhdl currPackHdl = NULL;
56VAR idhdl basePackHdl = NULL;
57VAR package currPack = NULL;
58VAR package basePack = NULL;
59VAR idhdl currRingHdl = NULL;
60
61void paCleanUp(package pack);
62
63/*0 implementation*/
64
65static inline long iiS2I(const char *s)
66{
67  long l;
68  strncpy((char*)&l,s,SIZEOF_LONG);
69  return l;
70}
71
72idhdl idrec::get(const char * s, int level)
73{
74  assume(s!=NULL);
75  assume((level>=0) && (level<=1000)); //not really, but if it isnt in that bounds..
76  idhdl h = this;
77  idhdl found=NULL;
78  int l;
79  const char *id_;
80  unsigned long i=iiS2I(s);
81  int less4=(i < (1L<<((SIZEOF_LONG-1)*8)));
82  while (h!=NULL)
83  {
84    omCheckAddr((ADDRESS)IDID(h));
85    l=IDLEV(h);
86    if ((l==0)||(l==level))
87    {
88      if (i==h->id_i)
89      {
90        id_=IDID(h);
91        if (less4 || (0 == strcmp(s+SIZEOF_LONG,id_+SIZEOF_LONG)))
92        {
93          if(l==level) return h;
94          found=h;
95        }
96      }
97    }
98    h = IDNEXT(h);
99  }
100  return found;
101}
102
103//idrec::~idrec()
104//{
105//  if (id!=NULL)
106//  {
107//    omFree((ADDRESS)id);
108//    id=NULL;
109//  }
110//  /* much more !! */
111//}
112
113void *idrecDataInit(int t)
114{
115  switch (t)
116  {
117    //the type with init routines:
118#ifdef SINGULAR_4_2
119    case CNUMBER_CMD:
120      return (void*)n2Init(0,NULL);
121    case CPOLY_CMD:
122      return (void*)p2Init(0,NULL);
123    case CMATRIX_CMD:
124#endif
125    case BIGINTMAT_CMD:
126      return (void *)new bigintmat();
127    case BUCKET_CMD:
128      if (currRing!=NULL)
129      return (void*)sBucketCreate(currRing);
130      else
131      {
132        WerrorS("need basering for polyBucket");
133        return NULL;
134      }
135    case INTVEC_CMD:
136    case INTMAT_CMD:
137      return (void *)new intvec();
138    case NUMBER_CMD:
139    {
140      if (currRing!=NULL) return (void *) nInit(0);
141      else                return NULL;
142    }
143    case BIGINT_CMD:
144      return (void *) n_Init(0, coeffs_BIGINT);
145    case IDEAL_CMD:
146    case MODUL_CMD:
147    case MATRIX_CMD:
148    case SMATRIX_CMD:
149      return (void*) idInit(1,1);
150    case MAP_CMD:
151    {
152      map m = (map)idInit(1,1);
153      m->preimage = omStrDup(IDID(currRingHdl));
154      return (void *)m;
155    }
156    case STRING_CMD:
157      return (void *)omAlloc0(1);
158    case LIST_CMD:
159    {
160      lists l=(lists)omAllocBin(slists_bin);
161      l->Init();
162      return (void*)l;
163    }
164    //the types with the standard init: set the struct to zero
165    case LINK_CMD:
166      return (void*) omAlloc0Bin(sip_link_bin);
167    case RING_CMD:
168      return NULL;
169    case PACKAGE_CMD:
170    {
171      package pa=(package)omAlloc0Bin(sip_package_bin);
172      pa->language=LANG_NONE;
173      pa->loaded = FALSE;
174      return (void*)pa;
175    }
176    case PROC_CMD:
177    {
178      procinfov pi=(procinfov)omAlloc0Bin(procinfo_bin);
179      pi->ref=1;
180      pi->language=LANG_NONE;
181      return (void*)pi;
182    }
183    case RESOLUTION_CMD:
184      return  (void *)omAlloc0(sizeof(ssyStrategy));
185    //other types: without init (int,script,poly,def,package)
186    case CRING_CMD:
187    case INT_CMD:
188    case DEF_CMD:
189    case POLY_CMD:
190    case VECTOR_CMD:
191    case QRING_CMD:
192       return (void*)0L;
193    default:
194      {
195        if (t>MAX_TOK)
196        {
197#ifdef BLACKBOX_DEVEL
198          Print("bb-type %d\n",t);
199#endif
200          blackbox *bb=getBlackboxStuff(t);
201          if (bb!=NULL)
202             return (void *)bb->blackbox_Init(bb);
203        }
204        else
205          Werror("unknown type in idrecDataInit:%d",t);
206        break;
207      }
208  }
209  return (void *)0L;
210}
211idhdl idrec::set(const char * s, int level, int t, BOOLEAN init)
212{
213  //printf("define %s, %x, level: %d, typ: %d\n", s,s,level,t);
214  idhdl h = (idrec *)omAlloc0Bin(idrec_bin);
215  IDID(h)   = s;
216  IDTYP(h)  = t;
217  IDLEV(h)  = level;
218  IDNEXT(h) = this;
219  BOOLEAN at_start=(this==IDROOT);
220  h->id_i=iiS2I(s);
221  if (t==BUCKET_CMD) WarnS("defining polyBucket");
222  if (init)
223  {
224    if ((t==IDEAL_CMD)||(t==MODUL_CMD))
225      IDFLAG(h) = Sy_bit(FLAG_STD);
226    IDSTRING(h)=(char *)idrecDataInit(t);
227    // additional settings:--------------------------------------
228#if 0
229    // this leads to a memory leak
230    if (t == QRING_CMD)
231    {
232      // IDRING(h)=rCopy(currRing);
233      /* QRING_CMD is ring dep => currRing !=NULL */
234    }
235#endif
236  }
237  // --------------------------------------------------------
238  if (at_start)
239    IDNEXT(h) = IDROOT;
240  return  h;
241}
242
243char * idrec::String(BOOLEAN typed)
244{
245  sleftv tmp;
246  memset(&tmp,0,sizeof(sleftv));
247  tmp.rtyp=IDTYP(this);
248  tmp.data=IDDATA(this);
249  tmp.name=IDID(this);
250  return tmp.String(NULL, typed);
251}
252
253idhdl enterid(const char * s, int lev, int t, idhdl* root, BOOLEAN init, BOOLEAN search)
254{
255  if (s==NULL) return NULL;
256  if (root==NULL) return NULL;
257  idhdl h;
258  s=omStrDup(s);
259  // idhdl *save_root=root;
260  if (t==PACKAGE_CMD)
261  {
262    if (root!=&(basePack->idroot))
263    {
264      root=&(basePack->idroot);
265    }
266  }
267  // is it already defined in root ?
268  if ((h=(*root)->get(s,lev))!=NULL)
269  {
270    if (IDLEV(h)==lev)
271    {
272      if ((IDTYP(h) == t)||(t==DEF_CMD))
273      {
274        if (IDTYP(h)==PACKAGE_CMD)
275        {
276          if (strcmp(s,"Top")==0)
277          {
278            goto errlabel;
279          }
280          else return h;
281        }
282        else
283        {
284          if (BVERBOSE(V_REDEFINE))
285          {
286            const char *f=VoiceName();
287            if (strcmp(f,"STDIN")==0)
288              Warn("redefining %s (%s)",s,my_yylinebuf);
289            else
290              Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
291          }
292          if (s==IDID(h)) IDID(h)=NULL;
293          killhdl2(h,root,currRing);
294        }
295      }
296      else
297        goto errlabel;
298    }
299  }
300  // is it already defined in currRing->idroot ?
301  else if (search && (currRing!=NULL)&&((*root) != currRing->idroot))
302  {
303    if ((h=currRing->idroot->get(s,lev))!=NULL)
304    {
305      if (IDLEV(h)==lev)
306      {
307        if ((IDTYP(h) == t)||(t==DEF_CMD))
308        {
309          if (BVERBOSE(V_REDEFINE))
310          {
311            const char *f=VoiceName();
312            if (strcmp(f,"STDIN")==0)
313              Warn("redefining %s (%s)",s,my_yylinebuf);
314            else
315              Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
316          }
317          if (s==IDID(h)) IDID(h)=NULL;
318          killhdl2(h,&currRing->idroot,currRing);
319        }
320        else
321          goto errlabel;
322      }
323    }
324  }
325  // is it already defined in idroot ?
326  else if (search && (*root != IDROOT))
327  {
328    if ((h=IDROOT->get(s,lev))!=NULL)
329    {
330      if (IDLEV(h)==lev)
331      {
332        if ((IDTYP(h) == t)||(t==DEF_CMD))
333        {
334          if (BVERBOSE(V_REDEFINE))
335          {
336            const char *f=VoiceName();
337            if (strcmp(f,"STDIN")==0)
338              Warn("redefining %s (%s)",s,my_yylinebuf);
339            else
340              Warn("redefining %s (%s) %s:%d",s,my_yylinebuf,f, yylineno);
341          }
342          if (s==IDID(h)) IDID(h)=NULL;
343          killhdl2(h,&IDROOT,NULL);
344        }
345        else
346          goto errlabel;
347      }
348    }
349  }
350  *root = (*root)->set(s, lev, t, init);
351#ifndef SING_NDEBUG
352  checkall();
353#endif
354  return *root;
355
356  errlabel:
357    //Werror("identifier `%s` in use(lev h=%d,typ=%d,t=%d, curr=%d)",s,IDLEV(h),IDTYP(h),t,lev);
358    Werror("identifier `%s` in use",s);
359    //listall();
360    omFree((ADDRESS)s);
361    return NULL;
362}
363void killid(const char * id, idhdl * ih)
364{
365  if (id!=NULL)
366  {
367    idhdl h = (*ih)->get(id,myynest);
368
369    // id not found in global list, is it defined in current ring ?
370    if (h==NULL)
371    {
372      if ((currRing!=NULL) && (*ih != (currRing->idroot)))
373      {
374        h = currRing->idroot->get(id,myynest);
375        if (h!=NULL)
376        {
377          killhdl2(h,&(currRing->idroot),currRing);
378          return;
379        }
380      }
381      Werror("`%s` is not defined",id);
382      return;
383    }
384    killhdl2(h,ih,currRing);
385  }
386  else
387    WerrorS("kill what ?");
388}
389
390void killhdl(idhdl h, package proot)
391{
392  int t=IDTYP(h);
393  if (((BEGIN_RING<t) && (t<END_RING))
394  || ((t==LIST_CMD) && (lRingDependend((lists)IDDATA(h)))))
395    killhdl2(h,&currRing->idroot,currRing);
396  else
397  {
398    if(t==PACKAGE_CMD)
399    {
400      killhdl2(h,&(basePack->idroot),NULL);
401    }
402    else
403    {
404      idhdl s=proot->idroot;
405      while ((s!=h) && (s!=NULL)) s=s->next;
406      if (s!=NULL)
407        killhdl2(h,&(proot->idroot),NULL);
408      else if (basePack!=proot)
409      {
410        idhdl s=basePack->idroot;
411        while ((s!=h) && (s!=NULL)) s=s->next;
412        if (s!=NULL)
413          killhdl2(h,&(basePack->idroot),currRing);
414        else
415          killhdl2(h,&(currRing->idroot),currRing);
416       }
417    }
418  }
419}
420
421void killhdl2(idhdl h, idhdl * ih, ring r)
422{
423  //printf("kill %s, id %x, typ %d lev: %d\n",IDID(h),(int)IDID(h),IDTYP(h),IDLEV(h));
424  idhdl hh;
425
426  if (TEST_V_ALLWARN
427  && (IDLEV(h)!=myynest)
428  &&(IDLEV(h)==0))
429  {
430    if (((*ih)==basePack->idroot)
431    || ((currRing!=NULL)&&((*ih)==currRing->idroot)))
432      Warn("kill global `%s` at line >>%s<<\n",IDID(h),my_yylinebuf);
433  }
434  if (h->attribute!=NULL)
435  {
436    if ((IDTYP(h)==RING_CMD)&&(IDRING(h)!=r))
437       h->attribute->killAll(IDRING(h));
438    else
439       h->attribute->killAll(r);
440    h->attribute=NULL;
441  }
442  if (IDTYP(h) == PACKAGE_CMD)
443  {
444    if (((IDPACKAGE(h)->language==LANG_C)&&(IDPACKAGE(h)->idroot!=NULL))
445    || (strcmp(IDID(h),"Top")==0))
446    {
447      Warn("cannot kill `%s`",IDID(h));
448      return;
449    }
450    // any objects defined for this package ?
451    if ((IDPACKAGE(h)->ref<=0)  &&  (IDPACKAGE(h)->idroot!=NULL))
452    {
453      if (currPack==IDPACKAGE(h))
454      {
455        currPack=basePack;
456        currPackHdl=NULL;
457      }
458      idhdl * hd = &IDRING(h)->idroot;
459      idhdl  hdh = IDNEXT(*hd);
460      idhdl  temp;
461      while (hdh!=NULL)
462      {
463        temp = IDNEXT(hdh);
464        killhdl2(hdh,&(IDPACKAGE(h)->idroot),NULL);
465        hdh = temp;
466      }
467      killhdl2(*hd,hd,NULL);
468      if (IDPACKAGE(h)->libname!=NULL) omFree((ADDRESS)(IDPACKAGE(h)->libname));
469    }
470    paKill(IDPACKAGE(h));
471    if (currPackHdl==h) currPackHdl=packFindHdl(currPack);
472    iiCheckPack(currPack);
473  }
474  else if (IDTYP(h)==RING_CMD)
475    rKill(h);
476  else if (IDDATA(h)!=NULL)
477    s_internalDelete(IDTYP(h),IDDATA(h),r);
478  //  general  -------------------------------------------------------------
479  // now dechain it and delete idrec
480  if (IDID(h)!=NULL) // OB: ?????
481    omFree((ADDRESS)IDID(h));
482  IDID(h)=NULL;
483  IDDATA(h)=NULL;
484  if (h == (*ih))
485  {
486    // h is at the beginning of the list
487    *ih = IDNEXT(h) /* ==*ih */;
488  }
489  else if (ih!=NULL)
490  {
491    // h is somethere in the list:
492    hh = *ih;
493    loop
494    {
495      if (hh==NULL)
496      {
497        PrintS(">>?<< not found for kill\n");
498        return;
499      }
500      idhdl hhh = IDNEXT(hh);
501      if (hhh == h)
502      {
503        IDNEXT(hh) = IDNEXT(hhh);
504        break;
505      }
506      hh = hhh;
507    }
508  }
509  omFreeBin((ADDRESS)h, idrec_bin);
510}
511
512#if 0
513idhdl ggetid(const char *n, BOOLEAN /*local*/, idhdl *packhdl)
514{
515  idhdl h = IDROOT->get(n,myynest);
516  idhdl h2=NULL;
517  *packhdl = NULL;
518  if ((currRing!=NULL) && ((h==NULL)||(IDLEV(h)!=myynest)))
519  {
520    h2 = currRing->idroot->get(n,myynest);
521  }
522  if (h2==NULL) return h;
523  return h2;
524}
525#endif
526
527idhdl ggetid(const char *n)
528{
529  idhdl h = IDROOT->get(n,myynest);
530  if ((h!=NULL)&&(IDLEV(h)==myynest)) return h;
531  if (currRing!=NULL)
532  {
533    idhdl h2 = currRing->idroot->get(n,myynest);
534    if (h2!=NULL) return h2;
535  }
536  if (h!=NULL) return h;
537  if (basePack!=currPack)
538    return basePack->idroot->get(n,myynest);
539  return NULL;
540}
541
542void ipListFlag(idhdl h)
543{
544  if (hasFlag(h,FLAG_STD)) PrintS(" (SB)");
545#ifdef HAVE_PLURAL
546  if (hasFlag(h,FLAG_TWOSTD)) PrintS(" (2SB)");
547#endif
548}
549
550lists ipNameList(idhdl root)
551{
552  idhdl h=root;
553  /* compute the length */
554  int l=0;
555  while (h!=NULL) { l++; h=IDNEXT(h); }
556  /* allocate list */
557  lists L=(lists)omAllocBin(slists_bin);
558  L->Init(l);
559  /* copy names */
560  h=root;
561  l=0;
562  while (h!=NULL)
563  {
564    /* list is initialized with 0 => no need to clear anything */
565    L->m[l].rtyp=STRING_CMD;
566    L->m[l].data=omStrDup(IDID(h));
567    l++;
568    h=IDNEXT(h);
569  }
570  return L;
571}
572
573lists ipNameListLev(idhdl root, int lev)
574{
575  idhdl h=root;
576  /* compute the length */
577  int l=0;
578  while (h!=NULL) { if (IDLEV(h)==lev) l++; h=IDNEXT(h); }
579  /* allocate list */
580  lists L=(lists)omAllocBin(slists_bin);
581  L->Init(l);
582  /* copy names */
583  h=root;
584  l=0;
585  while (h!=NULL)
586  {
587    if (IDLEV(h)==lev)
588    {
589      /* list is initialized with 0 => no need to clear anything */
590      L->m[l].rtyp=STRING_CMD;
591      L->m[l].data=omStrDup(IDID(h));
592      l++;
593    }
594    h=IDNEXT(h);
595  }
596  return L;
597}
598
599/*
600* move 'tomove' from root1 list to root2 list
601*/
602static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
603{
604  idhdl h;
605  /* search 'tomove' in root2 : if found -> do nothing */
606  h=root2;
607  while ((h!=NULL) && (h!=tomove)) h=IDNEXT(h);
608  if (h!=NULL) return FALSE; /*okay */
609  /* search predecessor of h in root1, remove 'tomove' */
610  h=root1;
611  if (tomove==h)
612  {
613    root1=IDNEXT(h);
614  }
615  else
616  {
617    while ((h!=NULL) && (IDNEXT(h)!=tomove)) h=IDNEXT(h);
618    if (h==NULL) return TRUE; /* not in the list root1 -> do nothing */
619    IDNEXT(h)=IDNEXT(tomove);
620  }
621  /* add to root2 list */
622  IDNEXT(tomove)=root2;
623  root2=tomove;
624  return FALSE;
625}
626
627void  ipMoveId(idhdl tomove)
628{
629  if ((currRing!=NULL)&&(tomove!=NULL))
630  {
631    if (RingDependend(IDTYP(tomove))
632    || ((IDTYP(tomove)==LIST_CMD) && (lRingDependend(IDLIST(tomove)))))
633    {
634      /*move 'tomove' to ring id's*/
635      if (ipSwapId(tomove,IDROOT,currRing->idroot))
636      ipSwapId(tomove,basePack->idroot,currRing->idroot);
637    }
638    else
639    {
640      /*move 'tomove' to global id's*/
641      ipSwapId(tomove,currRing->idroot,IDROOT);
642    }
643  }
644}
645
646const char * piProcinfo(procinfov pi, const char *request)
647{
648  if((pi == NULL)||(pi->language==LANG_NONE)) return "empty proc";
649  else if (strcmp(request, "libname")  == 0) return pi->libname;
650  else if (strcmp(request, "procname") == 0) return pi->procname;
651  else if (strcmp(request, "type")     == 0)
652  {
653    switch (pi->language)
654    {
655      case LANG_SINGULAR: return "singular"; break;
656      case LANG_C:        return "object";   break;
657      case LANG_NONE:     return "none";     break;
658      default:            return "unknown language";
659    }
660  }
661  else if (strcmp(request, "ref")      == 0)
662  {
663    char p[8];
664    sprintf(p, "%d", pi->ref);
665    return omStrDup(p);  // MEMORY-LEAK
666  }
667  return "??";
668}
669
670BOOLEAN piKill(procinfov pi)
671{
672  (pi->ref)--;
673  if (pi->ref == 0)
674  {
675    if (pi->language==LANG_SINGULAR)
676    {
677      Voice *p=currentVoice;
678      while (p!=NULL)
679      {
680        if (p->pi==pi && pi->ref <= 1)
681        {
682          Warn("`%s` in use, can not be killed",pi->procname);
683          return TRUE;
684        }
685        p=p->next;
686      }
687    }
688    if (pi->libname != NULL) // OB: ????
689      omFree((ADDRESS)pi->libname);
690    if (pi->procname != NULL) // OB: ????
691      omFree((ADDRESS)pi->procname);
692
693    if( pi->language == LANG_SINGULAR)
694    {
695      if (pi->data.s.body != NULL) // OB: ????
696        omFree((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    omFreeBin((ADDRESS)pi,  procinfo_bin);
704  }
705  return FALSE;
706}
707
708void paCleanUp(package pack)
709{
710  (pack->ref)--;
711  if (pack->ref < 0)
712  {
713#ifndef HAVE_STATIC
714    if( pack->language == LANG_C)
715    {
716      Print("//dlclose(%s)\n",pack->libname);
717#ifdef HAVE_DYNAMIC_LOADING
718      dynl_close (pack->handle);
719#endif /* HAVE_DYNAMIC_LOADING */
720    }
721#endif /* HAVE_STATIC */
722    omFree((ADDRESS)pack->libname);
723    memset((void *) pack, 0, sizeof(sip_package));
724    pack->language=LANG_NONE;
725  }
726}
727
728void proclevel::push(char *n)
729{
730  //Print("push %s\n",n);
731  proclevel *p=(proclevel*)omAlloc0(sizeof(proclevel));
732  p->name=n;
733  p->cPackHdl=currPackHdl;
734  p->cPack=currPack;
735  p->next=this;
736  procstack=p;
737}
738void proclevel::pop()
739{
740  //Print("pop %s\n",name);
741  //if (currRing!=::currRing) PrintS("currRing wrong\n");;
742  //::currRing=this->currRing;
743  //if (r==NULL) Print("set ring to NULL at lev %d(%s)\n",myynest,name);
744  //::currRingHdl=this->currRingHdl;
745  //if((::currRingHdl==NULL)||(IDRING(::currRingHdl)!=(::currRing)))
746  //  ::currRingHdl=rFindHdl(::currRing,NULL,NULL);
747  //Print("restore pack=%s,1.obj=%s\n",IDID(currPackHdl),IDID(currPack->idroot));
748  currPackHdl=this->cPackHdl;
749  currPack=this->cPack;
750  iiCheckPack(currPack);
751  proclevel *p=this;
752  procstack=next;
753  omFreeSize(p,sizeof(proclevel));
754}
755
756idhdl packFindHdl(package r)
757{
758  idhdl h=basePack->idroot;
759  while (h!=NULL)
760  {
761    if ((IDTYP(h)==PACKAGE_CMD)
762        && (IDPACKAGE(h)==r))
763      return h;
764    h=IDNEXT(h);
765  }
766  return NULL;
767}
768
769BOOLEAN iiAlias(leftv p)
770{
771  if (iiCurrArgs==NULL)
772  {
773    Werror("not enough arguments for proc %s",VoiceName());
774    p->CleanUp();
775    return TRUE;
776  }
777  leftv h=iiCurrArgs;
778  iiCurrArgs=h->next;
779  h->next=NULL;
780  if (h->rtyp!=IDHDL)
781  {
782    BOOLEAN res=iiAssign(p,h);
783    h->CleanUp();
784    omFreeBin((ADDRESS)h, sleftv_bin);
785    return res;
786  }
787  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
788  {
789    WerrorS("type mismatch");
790    return TRUE;
791  }
792  idhdl pp=(idhdl)p->data;
793  switch(pp->typ)
794  {
795      case CRING_CMD:
796        nKillChar((coeffs)pp);
797        break;
798      case DEF_CMD:
799      case INT_CMD:
800        break;
801      case INTVEC_CMD:
802      case INTMAT_CMD:
803         delete IDINTVEC(pp);
804         break;
805      case NUMBER_CMD:
806         nDelete(&IDNUMBER(pp));
807         break;
808      case BIGINT_CMD:
809         n_Delete(&IDNUMBER(pp),coeffs_BIGINT);
810         break;
811      case MAP_CMD:
812         {
813           map im = IDMAP(pp);
814           omFree((ADDRESS)im->preimage);
815         }
816         // continue as ideal:
817      case IDEAL_CMD:
818      case MODUL_CMD:
819      case MATRIX_CMD:
820          idDelete(&IDIDEAL(pp));
821         break;
822      case PROC_CMD:
823      case RESOLUTION_CMD:
824      case STRING_CMD:
825         omFree((ADDRESS)IDSTRING(pp));
826         break;
827      case LIST_CMD:
828         IDLIST(pp)->Clean();
829         break;
830      case LINK_CMD:
831         omFreeBin(IDLINK(pp),sip_link_bin);
832         break;
833       // case ring: cannot happen
834       default:
835         Werror("unknown type %d",p->Typ());
836         return TRUE;
837  }
838  pp->typ=ALIAS_CMD;
839  IDDATA(pp)=(char*)h->data;
840  int eff_typ=h->Typ();
841  if ((RingDependend(eff_typ))
842  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
843  {
844    ipSwapId(pp,IDROOT,currRing->idroot);
845  }
846  h->CleanUp();
847  omFreeBin((ADDRESS)h, sleftv_bin);
848  return FALSE;
849}
850
Note: See TracBrowser for help on using the repository browser.