source: git/Singular/ipshell.cc @ 194f5e5

spielwiese
Last change on this file since 194f5e5 was 4b5c87, checked in by Hans Schönemann <hannes@…>, 26 years ago
* hannes: several changes concerning stdfac git-svn-id: file:///usr/local/Singular/svn/trunk@1416 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 17.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ipshell.cc,v 1.20 1998-04-22 07:48:59 Singular Exp $ */
5/*
6* ABSTRACT:
7*/
8
9//#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13
14#include "mod2.h"
15#include "tok.h"
16#include "ipid.h"
17#include "intvec.h"
18#include "mmemory.h"
19#include "febase.h"
20#include "polys.h"
21#include "ideals.h"
22#include "matpol.h"
23#include "kstd1.h"
24#include "ring.h"
25#include "subexpr.h"
26#include "maps.h"
27#include "syz.h"
28#include "numbers.h"
29#include "lists.h"
30#include "attrib.h"
31#include "ipconv.h"
32#include "silink.h"
33#include "ipshell.h"
34
35leftv iiCurrArgs=NULL;
36int  traceit = 0;
37char *lastreserved=NULL;
38
39int  myynest = -1;
40
41static BOOLEAN iiNoKeepRing=TRUE;
42
43/*0 implementation*/
44
45char * Tok2Cmdname(int tok)
46{
47  int i = 0;
48  if (tok < 0)
49  {
50    return cmds[0].name;
51  }
52  if (tok==ANY_TYPE) return "any_type";
53  if (tok==NONE) return "nothing";
54  //if (tok==IFBREAK) return "if_break";
55  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
56  //if (tok==ORDER_VECTOR) return "ordering";
57  //if (tok==REF_VAR) return "ref";
58  //if (tok==OBJECT) return "object";
59  //if (tok==PRINT_EXPR) return "print_expr";
60  if (tok==IDHDL) return "identifier";
61  while (cmds[i].tokval!=0)
62  {
63    if ((cmds[i].tokval == tok)&&(cmds[i].alias==0))
64    {
65      return cmds[i].name;
66    }
67    i++;
68  }
69  return cmds[0].name;
70}
71
72char * iiTwoOps(int t)
73{
74  if (t<127)
75  {
76    static char ch[2];
77    switch (t)
78    {
79      case '&':
80        return "and";
81      case '|':
82        return "or";
83      default:
84        ch[0]=t;
85        ch[1]='\0';
86        return ch;
87    }
88  }
89  switch (t)
90  {
91    case COLONCOLON:  return "::";
92    case DOTDOT:      return "..";
93    //case PLUSEQUAL:   return "+=";
94    //case MINUSEQUAL:  return "-=";
95    case MINUSMINUS:  return "--";
96    case PLUSPLUS:    return "++";
97    case EQUAL_EQUAL: return "==";
98    case LE:          return "<=";
99    case GE:          return ">=";
100    case NOTEQUAL:    return "<>";
101    default:          return Tok2Cmdname(t);
102  }
103}
104
105static void list1(char* s, idhdl h,BOOLEAN c)
106{
107  char buffer[22];
108  int l;
109
110  Print("%s%-20.20s [%d]  ",s,IDID(h),IDLEV(h));
111  if (h == currRingHdl) PrintS("*");
112  PrintS(Tok2Cmdname((int)IDTYP(h)));
113
114  ipListFlag(h);
115  switch(IDTYP(h))
116  {
117    case INT_CMD:     Print(" %d",IDINT(h)); break;
118    case INTVEC_CMD:  Print(" (%d)",IDINTVEC(h)->length()); break;
119    case INTMAT_CMD:  Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
120                   break;
121    case POLY_CMD:
122    case VECTOR_CMD:  if (c)
123                   {
124                     PrintS(" ");wrp(IDPOLY(h));
125                     if(IDPOLY(h) != NULL)
126                     {
127                       Print(", %d monomial(s)",pLength(IDPOLY(h)));
128                     }
129                   }
130                   break;
131    case MODUL_CMD:   Print(", rk %d", IDIDEAL(h)->rank);
132    case IDEAL_CMD:   Print(", %u generator(s)",
133                     IDELEMS(IDIDEAL(h)),IDIDEAL(h)->rank); break;
134    case MAP_CMD:
135                   Print(" from %s",IDMAP(h)->preimage); break;
136    case MATRIX_CMD: Print(" %u x %u"
137                        ,MATROWS(IDMATRIX(h))
138                        ,MATCOLS(IDMATRIX(h))
139                        );
140                   break;
141    case PROC_CMD:  if(strlen(IDPROC(h)->libname)>0)
142                      Print(" from %s",IDPROC(h)->libname);
143                   if(IDPROC(h)->is_static) Print(" (static)");
144                   break;
145    case STRING_CMD:
146                   {
147                     char *s;
148                     l=strlen(IDSTRING(h));
149                     memset(buffer,0,22);
150                     strncpy(buffer,IDSTRING(h),min(l,20));
151                     if ((s=strchr(buffer,'\n'))!=NULL)
152                     {
153                       *s='\0';
154                     }
155                     PrintS(" ");
156                     PrintS(buffer);
157                     if((s!=NULL) ||(l>20))
158                     {
159                       Print("..., %d char(s)",l);
160                     }
161                     break;
162                   }
163    case LIST_CMD:   Print(", size: %d",IDLIST(h)->nr+1);
164                   break;
165    case QRING_CMD:
166    case RING_CMD:
167#ifdef RDEBUG
168                   if (traceit &TRACE_SHOW_RINGS) Print(" <%d>",IDRING(h)->no);
169#endif
170                   break;
171    /*default:     break;*/
172  }
173  PrintLn();
174}
175
176void type_cmd(idhdl h)
177{
178  int saveShortOut=pShortOut;
179  pShortOut=1;
180  list1("// ",h,FALSE);
181  if (IDTYP(h)!=INT_CMD)
182  {
183    sleftv expr;
184    memset(&expr,0,sizeof(expr));
185    expr.rtyp=IDHDL;
186    expr.name=IDID(h);
187    expr.data=(void *)h;
188    expr.Print();
189  }
190  pShortOut=saveShortOut;
191}
192
193static void killlocals0(int v, idhdl * localhdl)
194{
195  idhdl h = *localhdl;
196  while (h!=NULL)
197  {
198    int vv;
199    //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
200    if ((vv=IDLEV(h))>0)
201    {
202      if (vv < v)
203      {
204        if (iiNoKeepRing) 
205        {
206          //PrintS(" break\n");
207          return;
208        } 
209        h = IDNEXT(h);
210        //PrintLn();
211      }
212      else if (vv >= v)
213      {
214        idhdl nexth = IDNEXT(h);
215        killhdl(h,localhdl);
216        h = nexth;
217        //PrintS("kill\n");
218      }
219    }
220    else
221    {
222      h = IDNEXT(h);
223      //PrintLn();
224    }
225  }
226}
227
228void killlocals(int v)
229{
230  killlocals0(v,&idroot);
231
232  idhdl h = idroot;
233  idhdl sh=currRingHdl;
234  BOOLEAN changed=FALSE;
235
236  while (h!=NULL)
237  {
238    if (((IDTYP(h)==QRING_CMD) || (IDTYP(h) == RING_CMD))
239    && (IDRING(h)->idroot!=NULL))
240    {
241      if (h!=currRingHdl) {changed=TRUE;rSetHdl(h,FALSE);}
242      killlocals0(v,&(IDRING(h)->idroot));
243    }
244    h = IDNEXT(h);
245  }
246  if (changed)
247  {
248    currRing=NULL;
249    currRingHdl=NULL;
250    rSetHdl(sh,TRUE);
251  }
252  if (myynest<=1) iiNoKeepRing=TRUE;
253}
254
255void list_cmd(int typ, const char* what, char *prefix,BOOLEAN iterate)
256{
257  idhdl h,start;
258  BOOLEAN all = typ==-1;
259  BOOLEAN really_all=FALSE;
260
261  if ( typ==0 )
262  {
263    if (strcmp(what,"all")==0)
264    {
265      really_all=TRUE;
266      h=idroot;
267    }
268    else
269    {
270      h = ggetid(what);
271      if (h!=NULL)
272      {
273        if (iterate) list1(prefix,h,TRUE);
274        if ((IDTYP(h)==RING_CMD)
275            || (IDTYP(h)==QRING_CMD)
276            || (IDTYP(h)==PACKAGE_CMD))
277          {
278            h=IDRING(h)->idroot;
279          }
280        else
281          return;
282      }
283      else
284      {
285        Werror("%s is undefined",what);
286        return;
287      }
288    }
289    all=TRUE;
290  }
291  else if ((typ>BEGIN_RING) && (typ<END_RING))
292  {
293    h = currRing->idroot;
294  }
295  else
296    h = idroot;
297  start=h;
298  while (h!=NULL)
299  {
300    if ((all && (IDTYP(h)!=PROC_CMD)) || (typ == IDTYP(h))
301    || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD)))
302    {
303      list1(prefix,h,start==currRingHdl);
304      if ((((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
305        && (really_all || (all && (h==currRingHdl)))
306        && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
307      ||(IDTYP(h)==PACKAGE_CMD))
308      {
309        list_cmd(0,IDID(h),"//      ",FALSE);
310      }
311    }
312    h = IDNEXT(h);
313  }
314}
315
316void test_cmd(int i)
317{
318  int ii=(char)i;
319
320  if (i == (-32))
321  {
322    test = 0;
323  }
324  else
325  {
326    if (i<0)
327    {
328      ii= -i;
329      if (Sy_bit(ii) & kOptions)
330      {
331        Warn("use the option command");
332        test &= ~Sy_bit(ii);
333      }
334      else if (Sy_bit(ii) & validOpts)
335        test &= ~Sy_bit(ii);
336    }
337    else if (i<32)
338    {
339      if (Sy_bit(ii) & kOptions)
340      {
341        Warn("use the option command");
342        test |= Sy_bit(ii);
343      }
344      else if (Sy_bit(ii) & validOpts)
345        test |= Sy_bit(ii);
346    }
347  }
348}
349
350int exprlist_length(leftv v)
351{
352  int rc = 0;
353  while (v!=NULL)
354  {
355    switch (v->Typ())
356    {
357      case INT_CMD:
358      case POLY_CMD:
359      case VECTOR_CMD:
360      case NUMBER_CMD:
361        rc++;
362        break;
363      case INTVEC_CMD:
364      case INTMAT_CMD:
365        rc += ((intvec *)(v->Data()))->length();
366        break;
367      case MATRIX_CMD:
368      case IDEAL_CMD:
369      case MODUL_CMD:
370        {
371          matrix mm = (matrix)(v->Data());
372          rc += mm->rows() * mm->cols();
373        }
374        break;
375      case LIST_CMD:
376        rc+=((lists)v->Data())->nr+1;
377        break;
378      default:
379        rc++;
380    }
381    v = v->next;
382  }
383  return rc;
384}
385
386void iiWriteMatrix(matrix im, const char *n, int dim,int spaces)
387{
388  int i,ii = MATROWS(im)-1;
389  int j,jj = MATCOLS(im)-1;
390  poly *pp = im->m;
391
392  for (i=0; i<=ii; i++)
393  {
394    for (j=0; j<=jj; j++)
395    {
396      if (spaces>0)
397        Print("%-*.*s",spaces,spaces," ");
398      if (dim == 2) Print("%s[%u,%u]=",n,i+1,j+1);
399      else if (dim == 1) Print("%s[%u]=",n,j+1);
400      else if (dim == 0) Print("%s=",n);
401      if ((i<ii)||(j<jj)) pWrite(*pp++);
402      else                pWrite0(*pp);
403    }
404  }
405}
406
407char * iiStringMatrix(matrix im, int dim,char ch)
408{
409  int i,ii = MATROWS(im);
410  int j,jj = MATCOLS(im);
411  poly *pp = im->m;
412  char *s=StringSet("");
413
414  for (i=0; i<ii; i++)
415  {
416    for (j=0; j<jj; j++)
417    {
418      pString0(*pp++);
419      s=StringAppend("%c\n",ch);
420    }
421  }
422  s[strlen(s)-2]='\0';
423  return s;
424}
425
426int IsPrime(int p)  /* brute force !!!! */
427{
428  int i,j;
429  if      (p == 0) return 0;
430  else if (p == 1) return 1/*1*/;
431  else if (p == 2) return p;
432  else if (p <  0) return (-IsPrime(-p));
433  else if (!(p & 1)) return IsPrime(p-1);
434  for (j=p/2+1,i=3; i<p; i+=2)
435  {
436    if ((p%i) == 0) return IsPrime(p-2);
437    if (j < i) return p;
438  }
439  return p;
440}
441
442BOOLEAN iiWRITE(leftv res,leftv v)
443{
444  sleftv vf;
445  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
446  {
447    WerrorS("link expected");
448    return TRUE;
449  }
450  si_link l=(si_link)vf.Data();
451  if (vf.next == NULL)
452  {
453    WerrorS("write: need at least two arguments");
454    return TRUE;
455  }
456
457  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
458  if (b)
459  {
460    const char *s;
461    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
462    else                            s=sNoName;
463    Werror("cannot write to %s",s);
464  }
465  vf.CleanUp();
466  return b;
467}
468
469leftv iiMap(map theMap, char * what)
470{
471  idhdl w,r;
472  leftv v;
473  int i;
474
475  r=idroot->get(theMap->preimage,myynest);
476  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
477  {
478    if (!nSetMap(IDRING(r)->ch,IDRING(r)->parameter,IDRING(r)->P, IDRING(r)->minpoly))
479    {
480      Werror("map from characteristic %d to %d not implemented",
481        IDRING(r)->ch,currRing->ch);
482      return NULL;
483    }
484    if (IDELEMS(theMap)<IDRING(r)->N)
485    {
486      theMap->m=(polyset)ReAlloc((ADDRESS)theMap->m,IDELEMS(theMap)*sizeof(poly),
487                                     (IDRING(r)->N)*sizeof(poly));
488      for(i=IDELEMS(theMap);i<IDRING(r)->N;i++)
489        theMap->m[i]=NULL;
490      IDELEMS(theMap)=IDRING(r)->N;
491    }
492    if (what==NULL)
493    {
494      WerrorS("argument of a map must have a name");
495    }
496    else if ((w=IDRING(r)->idroot->get(what,myynest))!=NULL)
497    {
498      v=(leftv)Alloc0(sizeof(*v));
499      sleftv tmpW;
500      memset(&tmpW,0,sizeof(sleftv));
501      tmpW.rtyp=IDTYP(w);
502      tmpW.data=IDDATA(w);
503      if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,IDRING(r),NULL,NULL,0))
504      {
505        Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
506        Free((ADDRESS)v,sizeof(*v));
507        return NULL;
508      }
509      return v;
510    }
511    else
512      Werror("%s undefined in %s",what,theMap->preimage);
513  }
514  else
515    Werror("cannot find preimage %s",theMap->preimage);
516  return NULL;
517}
518
519#ifdef OLD_RES
520void  iiMakeResolv(resolvente r, int length, int rlen, char * name, int typ0,
521                   intvec ** weights)
522{
523  lists L=liMakeResolv(r,length,rlen,typ0,weights);
524  int i=0;
525  idhdl h;
526  char * s=(char *)Alloc(strlen(name)+5);
527
528  while (i<=L->nr)
529  {
530    sprintf(s,"%s(%d)",name,i+1);
531    if (i==0)
532      h=enterid(mstrdup(s),myynest,typ0,&(currRing->idroot), FALSE);
533    else
534      h=enterid(mstrdup(s),myynest,MODUL_CMD,&(currRing->idroot), FALSE);
535    if (h!=NULL)
536    {
537      h->data.uideal=(ideal)L->m[i].data;
538      h->attribute=L->m[i].attribute;
539      if (BVERBOSE(V_DEF_RES))
540        Print("//defining: %s as %d-th syzygy module\n",s,i+1);
541    }
542    else
543    {
544      idDelete((ideal *)&(L->m[i].data));
545      Warn("cannot define %s",s);
546    }
547    //L->m[i].data=NULL;
548    //L->m[i].rtyp=0;
549    //L->m[i].attribute=NULL;
550    i++;
551  }
552  Free((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
553  Free((ADDRESS)L,sizeof(slists));
554  Free((ADDRESS)s,strlen(name)+5);
555}
556#endif
557
558//resolvente iiFindRes(char * name, int * len, int *typ0)
559//{
560//  char *s=(char *)Alloc(strlen(name)+5);
561//  int i=-1;
562//  resolvente r;
563//  idhdl h;
564//
565//  do
566//  {
567//    i++;
568//    sprintf(s,"%s(%d)",name,i+1);
569//    h=currRing->idroot->get(s,myynest);
570//  } while (h!=NULL);
571//  *len=i-1;
572//  if (*len<=0)
573//  {
574//    Werror("no objects %s(1),.. found",name);
575//    Free((ADDRESS)s,strlen(name)+5);
576//    return NULL;
577//  }
578//  r=(ideal *)Alloc(/*(len+1)*/ i*sizeof(ideal));
579//  memset(r,0,(*len)*sizeof(ideal));
580//  i=-1;
581//  *typ0=MODUL_CMD;
582//  while (i<(*len))
583//  {
584//    i++;
585//    sprintf(s,"%s(%d)",name,i+1);
586//    h=currRing->idroot->get(s,myynest);
587//    if (h->typ != MODUL_CMD)
588//    {
589//      if ((i!=0) || (h->typ!=IDEAL_CMD))
590//      {
591//        Werror("%s is not of type module",s);
592//        Free((ADDRESS)r,(*len)*sizeof(ideal));
593//        Free((ADDRESS)s,strlen(name)+5);
594//        return NULL;
595//      }
596//      *typ0=IDEAL_CMD;
597//    }
598//    if ((i>0) && (idIs0(r[i-1])))
599//    {
600//      *len=i-1;
601//      break;
602//    }
603//    r[i]=IDIDEAL(h);
604//  }
605//  Free((ADDRESS)s,strlen(name)+5);
606//  return r;
607//}
608
609static resolvente iiCopyRes(resolvente r, int l)
610{
611  int i;
612  resolvente res=(ideal *)Alloc0((l+1)*sizeof(ideal));
613
614  for (i=0; i<l; i++)
615    res[i]=idCopy(r[i]);
616  return res;
617}
618
619BOOLEAN jjMINRES(leftv res, leftv v)
620{
621  int len=0;
622  int typ0;
623  resolvente rr=liFindRes((lists)v->Data(),&len,&typ0);
624  if (rr==NULL) return TRUE;
625  resolvente r=iiCopyRes(rr,len);
626
627  syMinimizeResolvente(r,len,0);
628  Free((ADDRESS)rr,len*sizeof(ideal));
629  len++;
630  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL);
631  return FALSE;
632}
633
634BOOLEAN jjBETTI(leftv res, leftv v)
635{
636  resolvente r;
637  int len;
638  int reg,typ0;
639
640  r=liFindRes((lists)v->Data(),&len,&typ0);
641  if (r==NULL) return TRUE;
642  res->data=(char *)syBetti(r,len,&reg);
643  Free((ADDRESS)r,(len)*sizeof(ideal));
644  return FALSE;
645}
646
647int iiRegularity(lists L)
648{
649  resolvente r;
650  int len,reg,typ0;
651  intvec * dummy;
652
653  r=liFindRes(L,&len,&typ0);
654  if (r==NULL) return -1;
655  dummy=syBetti(r,len,&reg);
656  Free((ADDRESS)r,len*sizeof(ideal));
657  delete dummy;
658  return reg-1;
659}
660
661BOOLEAN iiDebugMarker=TRUE;
662void iiDebug()
663{
664  Print("\n-- break point in %s --\n",VoiceName());
665  if (iiDebugMarker) VoiceBackTrack();
666  char * s;
667  iiDebugMarker=FALSE;
668  s = (char *)AllocL(84);
669  fe_fgets_stdin(s,80);
670  if (*s=='\n')
671  {
672    iiDebugMarker=TRUE;
673  }
674  else
675  {
676    strcat( s, "\n;~\n");
677    newBuffer(s,BT_execute);
678  }
679}
680
681int iiDeclCommand(leftv sy, leftv name, int lev,int t, idhdl* root,BOOLEAN init_b)
682{
683  BOOLEAN res=FALSE;
684  memset(sy,0,sizeof(sleftv));
685  if ((name->name==NULL)||(isdigit(name->name[0])))
686  {
687    WerrorS("object to declare is not a name");
688    res=TRUE;
689  }
690  else
691  {
692    //if (name->rtyp!=0)
693    //{
694    //  Warn("`%s` is already in use",name->name);
695    //}
696    sy->data = (char *)enterid(name->name,lev,t,root,init_b);
697    if (sy->data!=NULL)
698    {
699      sy->rtyp=IDHDL;
700      currid=sy->name=IDID((idhdl)sy->data);
701      name->name=NULL; /* used in enterid */
702      //sy->e = NULL;
703      if (name->next!=NULL)
704      {
705        sy->next=(leftv)Alloc(sizeof(sleftv));
706        res=iiDeclCommand(sy->next,name->next,lev,t,root);
707      }
708    }
709    else res=TRUE;
710  }
711  name->CleanUp();
712  return res;
713}
714
715BOOLEAN iiParameter(leftv p)
716{
717  if (iiCurrArgs==NULL)
718  {
719    if (strcmp(p->name,"#")==0) return FALSE;
720    Werror("not enough arguments for proc %s",VoiceName());
721    p->CleanUp();
722    return TRUE;
723  }
724  leftv h=iiCurrArgs;
725  if (strcmp(p->name,"#")==0)
726  {
727    iiCurrArgs=NULL;
728  }
729  else
730  {
731    iiCurrArgs=h->next;
732    h->next=NULL;
733  }
734  BOOLEAN res=iiAssign(p,h);
735  Free((ADDRESS)h,sizeof(sleftv));
736  return res;
737}
738
739BOOLEAN iiExport (leftv v, int toLev)
740{
741  BOOLEAN nok=FALSE;
742  leftv r=v;
743  while (v!=NULL)
744  {
745    if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
746    {
747      WerrorS("cannot export");
748      nok=TRUE;
749    }
750    else
751    {
752      idhdl h=(idhdl)v->data;
753      if (IDLEV(h)==0) Warn("`%s` is already global",IDID(h));
754      else
755      {
756        h=idroot->get(v->name,toLev);
757        idhdl *root=&idroot;
758        if ((h==NULL)&&(currRing!=NULL))
759        {
760          h=currRing->idroot->get(v->name,toLev);
761          root=&currRing->idroot;
762        }
763        if ((h!=NULL)&&(IDLEV(h)==toLev))
764        {
765          if (IDTYP(h)==v->Typ())
766          {
767            Warn("redefining %s",IDID(h));
768            if (iiLocalRing[0]==IDRING(h)) iiLocalRing[0]=NULL;
769            killhdl(h,root);
770          }
771          else
772          {
773            r->CleanUp();
774            return TRUE;
775          }
776        }
777        h=(idhdl)v->data;
778        IDLEV(h)=toLev;
779        iiNoKeepRing=FALSE;
780      }
781    }
782    v=v->next;
783  }
784  r->CleanUp();
785  return nok;
786}
787
788/*assume root!=idroot*/
789BOOLEAN iiExport (leftv v, int toLev, idhdl &root)
790{
791  BOOLEAN nok=FALSE;
792  leftv rv=v;
793  while (v!=NULL)
794  {
795    if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
796    )
797    {
798      WerrorS("cannot export");
799      nok=TRUE;
800    }
801    else
802    {
803      idhdl old=root->get(v->name,toLev);
804      if (old!=NULL)
805      {
806        if (IDTYP(old)==v->Typ())
807        {
808          Warn("redefining %s",IDID(old));
809          killhdl(old,&root);
810        }
811        else
812        {
813          rv->CleanUp();
814          return TRUE;
815        }
816      }
817      idhdl h=(idhdl)v->data;
818      if (h==idroot)
819      {
820        idroot=h->next;
821      }
822      else
823      {
824        idhdl hh=idroot;
825        while ((hh->next!=h)&&(hh->next!=NULL))
826          hh=hh->next;
827        if (hh->next==h)
828          hh->next=h->next;
829        else
830          break;
831      }
832      h->next=root;
833      root=h;
834      IDLEV(h)=toLev;
835    }
836    v=v->next;
837  }
838  rv->CleanUp();
839  return nok;
840}
841
842BOOLEAN iiCheckRing(int i)
843{
844  if (currRingHdl==NULL)
845  {
846    #ifdef SIQ
847    if (siq<=0)
848    {
849    #endif
850      if ((i>BEGIN_RING) && (i<END_RING))
851      {
852        WerrorS("no ring active");
853        return TRUE;
854      }
855    #ifdef SIQ
856    }
857    #endif
858  }
859  return FALSE;
860}
Note: See TracBrowser for help on using the repository browser.