source: git/Singular/grammar.y @ b4d18fc

spielwiese
Last change on this file since b4d18fc was b4d18fc, checked in by Hans Schönemann <hannes@…>, 23 years ago
*hannes: LIB not as string git-svn-id: file:///usr/local/Singular/svn/trunk@5334 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 44.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: grammar.y,v 1.89 2001-03-23 18:27:40 Singular Exp $ */
5/*
6* ABSTRACT: SINGULAR shell grammatik
7*/
8%{
9
10#include <stdio.h>
11#include <stddef.h>
12#include <stdlib.h>
13#include <stdarg.h>
14#include <string.h>
15#include <limits.h>
16#ifdef __MWERKS__
17  #ifdef __POWERPC__
18    #include <alloca.h>
19  #else
20    #ifdef macintosh
21      #define alloca malloc /* this is not corect! */
22    #else
23      #include <malloc.h>
24    #endif
25  #endif
26#endif
27
28#include "mod2.h"
29#include "omalloc.h"
30#include "tok.h"
31#include "stype.h"
32#include "ipid.h"
33#include "intvec.h"
34#include "febase.h"
35#include "matpol.h"
36#include "ring.h"
37#include "kstd1.h"
38#include "subexpr.h"
39#include "ipshell.h"
40#include "ipconv.h"
41#include "sdb.h"
42#include "ideals.h"
43#include "numbers.h"
44#include "polys.h"
45#include "weight.h"
46#include "stairc.h"
47#include "timer.h"
48#include "cntrlc.h"
49#include "maps.h"
50#include "syz.h"
51#include "lists.h"
52#include "libparse.h"
53
54/* From the bison docu:
55
56     By defining the macro `YYMAXDEPTH', you can control how deep the
57parser stack can become before a stack overflow occurs.  Define the
58macro with a value that is an integer.  This value is the maximum number
59of tokens that can be shifted (and not reduced) before overflow.  It
60must be a constant expression whose value is known at compile time.
61
62   The stack space allowed is not necessarily allocated.  If you
63specify a large value for `YYMAXDEPTH', the parser actually allocates a
64small stack at first, and then makes it bigger by stages as needed.
65This increasing allocation happens automatically and silently.
66Therefore, you do not need to make `YYMAXDEPTH' painfully small merely
67to save space for ordinary inputs that do not need much stack.
68
69   The default value of `YYMAXDEPTH', if you do not define it, is 10000.
70*/
71#define YYMAXDEPTH INT_MAX
72
73extern int   yylineno;
74extern FILE* yyin;
75
76char       my_yylinebuf[80];
77char *     currid;
78BOOLEAN    yyInRingConstruction=FALSE;
79BOOLEAN    expected_parms;
80int        cmdtok;
81int        inerror = 0;
82
83#define TESTSETINT(a,i)                                \
84   if ((a).Typ() != INT_CMD)                           \
85   {                                                   \
86     WerrorS("no int expression");                     \
87     YYERROR;                                          \
88   }                                                   \
89   (i) = (int)(a).Data();
90
91#define MYYERROR(a) { WerrorS(a); YYERROR; }
92
93void yyerror(char * fmt)
94{
95
96  BOOLEAN old_errorreported=errorreported;
97  errorreported = TRUE;
98  if (currid!=NULL)
99  {
100    killid(currid,&IDROOT);
101    currid = NULL;
102  }
103  if(inerror==0)
104  {
105    #ifdef HAVE_TCL
106    if (tclmode)
107    { /* omit output of line number if tclmode and stdin */
108      const char *n=VoiceName();
109      if (strcmp(n,"STDIN")==0)
110        Werror( "error occurred in %s: `%s`"
111               ,n, my_yylinebuf);
112      else
113        Werror( "error occurred in %s line %d: `%s`"
114               ,n, yylineno, my_yylinebuf);
115    }
116    else
117    #endif
118    {
119      if ((strlen(fmt)>1) && (strncmp(fmt,"parse",5)!=0))
120        WerrorS(fmt);
121      Werror( "error occurred in %s line %d: `%s`"
122             ,VoiceName(), yylineno, my_yylinebuf);
123    }
124    if (cmdtok!=0)
125    {
126      char *s=Tok2Cmdname(cmdtok);
127      if (expected_parms)
128      {
129        Werror("expected %s-expression. type \'help %s;\'",s,s);
130      }
131      else
132      {
133        Werror("wrong type declaration. type \'help %s;\'",s);
134      }
135    }
136    if (!old_errorreported && (lastreserved!=NULL))
137    {
138      Werror("last reserved name was `%s`",lastreserved);
139    }
140    inerror=1;
141  }
142  if ((currentVoice!=NULL)
143  && (currentVoice->prev!=NULL)
144  && (myynest>0)
145  && ((sdb_flags &1)==0))
146  {
147    Werror("leaving %s",VoiceName());
148  }
149}
150
151%}
152
153/* %expect 22 */
154%pure_parser
155
156/* special symbols */
157%token DOTDOT
158%token EQUAL_EQUAL
159%token GE
160%token LE
161%token MINUSMINUS
162%token NOT
163%token NOTEQUAL
164%token PLUSPLUS
165%token COLONCOLON
166
167/* types, part 1 (ring indep.)*/
168%token <i> DRING_CMD
169%token <i> INTMAT_CMD
170%token <i> PROC_CMD
171%token <i> RING_CMD
172
173/* valid when ring defined ! */
174%token <i> BEGIN_RING
175/* types, part 2 */
176%token <i> IDEAL_CMD
177%token <i> MAP_CMD
178%token <i> MATRIX_CMD
179%token <i> MODUL_CMD
180%token <i> NUMBER_CMD
181%token <i> POLY_CMD
182%token <i> RESOLUTION_CMD
183%token <i> VECTOR_CMD
184/* end types */
185
186/* ring dependent cmd:*/
187%token <i> BETTI_CMD
188%token <i> COEFFS_CMD
189%token <i> COEF_CMD
190%token <i> CONTRACT_CMD
191%token <i> DEGREE_CMD
192%token <i> DEG_CMD
193%token <i> DIFF_CMD
194%token <i> DIM_CMD
195%token <i> DIVISION_CMD
196%token <i> ELIMINATION_CMD
197%token <i> E_CMD
198%token <i> FETCH_CMD
199%token <i> FREEMODULE_CMD
200%token <i> KEEPRING_CMD
201%token <i> HILBERT_CMD
202%token <i> HOMOG_CMD
203%token <i> IMAP_CMD
204%token <i> INDEPSET_CMD
205%token <i> INTERRED_CMD
206%token <i> INTERSECT_CMD
207%token <i> JACOB_CMD
208%token <i> JET_CMD
209%token <i> KBASE_CMD
210%token <i> KOSZUL_CMD
211%token <i> LEADCOEF_CMD
212%token <i> LEADEXP_CMD
213%token <i> LEAD_CMD
214%token <i> LEADMONOM_CMD
215%token <i> LIFTSTD_CMD
216%token <i> LIFT_CMD
217%token <i> MAXID_CMD
218%token <i> MINBASE_CMD
219%token <i> MINOR_CMD
220%token <i> MINRES_CMD
221%token <i> MODULO_CMD
222%token <i> MRES_CMD
223%token <i> MULTIPLICITY_CMD
224%token <i> ORD_CMD
225%token <i> PAR_CMD
226%token <i> PARDEG_CMD
227%token <i> PREIMAGE_CMD
228%token <i> QUOTIENT_CMD
229%token <i> QHWEIGHT_CMD
230%token <i> REDUCE_CMD
231%token <i> REGULARITY_CMD
232%token <i> RES_CMD
233%token <i> SIMPLIFY_CMD
234%token <i> SORTVEC_CMD
235%token <i> SRES_CMD
236%token <i> STD_CMD
237%token <i> SUBST_CMD
238%token <i> SYZYGY_CMD
239%token <i> VAR_CMD
240%token <i> VDIM_CMD
241%token <i> WEDGE_CMD
242%token <i> WEIGHT_CMD
243
244/*system variables in ring block*/
245%token <i> VALTVARS
246%token <i> VMAXDEG
247%token <i> VMAXMULT
248%token <i> VNOETHER
249%token <i> VMINPOLY
250
251%token <i> END_RING
252/* end of ring definitions */
253
254%token <i> CMD_1
255%token <i> CMD_2
256%token <i> CMD_3
257%token <i> CMD_12
258%token <i> CMD_13
259%token <i> CMD_23
260%token <i> CMD_123
261%token <i> CMD_M
262%token <i> ROOT_DECL
263        /* put variables of this type into the idroot list */
264%token <i> ROOT_DECL_LIST
265        /* put variables of this type into the idroot list */
266%token <i> RING_DECL
267        /* put variables of this type into the currRing list */
268%token <i> EXAMPLE_CMD
269%token <i> EXPORT_CMD
270%token <i> EXPORTTO_CMD
271%token <i> IMPORTFROM_CMD
272%token <i> HELP_CMD
273%token <i> KILL_CMD
274%token <i> LIB_CMD
275%token <i> LISTVAR_CMD
276%token <i> SETRING_CMD
277%token <i> TYPE_CMD
278
279%token <name> STRINGTOK BLOCKTOK INT_CONST
280%token <name> UNKNOWN_IDENT RINGVAR PROC_DEF
281
282/* control */
283%token <i> BREAK_CMD
284%token <i> CONTINUE_CMD
285%token <i> ELSE_CMD
286%token <i> EVAL
287%token <i> QUOTE
288%token <i> FOR_CMD
289%token <i> IF_CMD
290%token <i> SYS_BREAK
291%token <i> WHILE_CMD
292%token <i> RETURN
293%token <i> PARAMETER
294
295/* system variables */
296%token <i> SYSVAR
297
298%type <name> extendedid
299%type <lv>   rlist ordering OrderingList orderelem
300%type <name> stringexpr
301%type <lv>   expr elemexpr exprlist expr_arithmetic
302%type <lv>   declare_ip_variable left_value
303%type <i>    ordername
304%type <i>    cmdeq
305%type <i>    currring_lists
306%type <i>    setrings
307%type <i>    ringcmd1
308
309%type <i>    '=' '<' '>' '+' '-' COLONCOLON
310%type <i>    '/' '[' ']' '^' ',' ';'
311
312
313/*%nonassoc '=' PLUSEQUAL DOTDOT*/
314/*%nonassoc '=' DOTDOT COLONCOLON*/
315%nonassoc '=' DOTDOT
316%left ','
317%left '&'
318%left EQUAL_EQUAL NOTEQUAL
319%left '<'
320%left '+' '-'
321%left '/'
322%left UMINUS NOT
323%left  '^'
324%left '[' ']'
325%left '(' ')'
326%left PLUSPLUS MINUSMINUS
327%left COLONCOLON
328
329%%
330lines:
331        /**/
332        | lines pprompt
333          {
334            if (timerv)
335            {
336              writeTime("used time:");
337              startTimer();
338            }
339            #ifdef HAVE_RTIMER
340            if (rtimerv)
341            {
342              writeRTime("used real time:");
343              startRTimer();
344            }
345            #endif
346            prompt_char = '>';
347            if (sdb_flags & 2) { sdb_flags=1; YYERROR; }
348            if(siCntrlc)
349            {
350              siCntrlc=FALSE;
351              MYYERROR("abort...");
352            }
353            if (errorreported)
354            {
355              yyerror("");
356            }
357            if (inerror==2) PrintLn();
358            errorreported = inerror = cmdtok = 0;
359            lastreserved = currid = NULL;
360            expected_parms = siCntrlc = FALSE;
361          }
362        ;
363
364pprompt:
365        flowctrl                       /* if, while, for, proc */
366        | command ';'                  /* commands returning no value */
367          {currentVoice->ifsw=0;}
368        | declare_ip_variable ';'      /* default initialization */
369          { $1.CleanUp(); currentVoice->ifsw=0;}
370        | returncmd
371          {
372            YYACCEPT;
373          }
374        | SYS_BREAK
375          {
376            currentVoice->ifsw=0;
377            iiDebug();
378          }
379        | ';'                    /* ignore empty statements */
380          {currentVoice->ifsw=0;}
381        | error ';'
382          {
383            #ifdef SIQ
384            siq=0;
385            #endif
386            yyInRingConstruction = FALSE;
387            currentVoice->ifsw=0;
388            if (inerror)
389            {
390              if ((inerror!=3) && ($1.i<UMINUS) && ($1.i>' '))
391              {
392                // 1: yyerror called
393                // 2: scanner put actual string
394                // 3: error rule put token+\n
395                inerror=3;
396                Print(" error at token `%s`\n",iiTwoOps($1.i));
397              }
398            }
399            if (!errorreported) WerrorS("...parse error");
400            yyerror("");
401            yyerrok;
402            if ((sdb_flags & 1) && currentVoice->pi!=NULL)
403            {
404              currentVoice->pi->trace_flag |=1;
405            }
406            else
407            if (myynest>0)
408            {
409              feBufferTypes t=currentVoice->Typ();
410              //PrintS("leaving yyparse\n");
411              exitBuffer(BT_proc);
412              if (t==BT_example)
413                YYACCEPT;
414              else
415                YYABORT;
416            }
417            else if (currentVoice->prev!=NULL)
418            {
419              exitVoice();
420            }
421            if (sdb_flags &2) sdb_flags=1;
422          }
423        ;
424
425flowctrl: ifcmd
426          | whilecmd
427          | example_dummy
428          | forcmd
429          | proccmd
430          | filecmd
431          | helpcmd
432          | examplecmd
433            {currentVoice->ifsw=0;}
434        ;
435
436example_dummy : EXAMPLE_CMD BLOCKTOK { omFree((ADDRESS)$2); }
437
438command: assign
439         | exportcmd
440         | killcmd
441         | listcmd
442         | parametercmd
443         | ringcmd
444         | scriptcmd
445         | setringcmd
446         | typecmd
447         ;
448
449assign: left_value exprlist
450          {
451            if(iiAssign(&$1,&$2)) YYERROR;
452          }
453        ;
454
455elemexpr:
456        RINGVAR
457          {
458            if (currRing==NULL) MYYERROR("no ring active");
459            syMake(&$$,omStrDup($1));
460          }
461        | extendedid
462          {
463            syMake(&$$,$1);
464          }
465        | elemexpr COLONCOLON elemexpr
466          {
467            if(iiExprArith2(&$$, &$1, COLONCOLON, &$3)) YYERROR;
468          }
469        | elemexpr '('  ')'
470          {
471            if(iiExprArith1(&$$,&$1,'(')) YYERROR;
472          }
473        | elemexpr '(' exprlist ')'
474          {
475            if ($1.rtyp==LIB_CMD)
476            {
477              if(iiExprArith1(&$$,&$3,LIB_CMD)) YYERROR;
478            }
479            else
480            {
481              $1.next=(leftv)omAllocBin(sleftv_bin);
482              memcpy($1.next,&$3,sizeof(sleftv));
483              if(iiExprArithM(&$$,&$1,'(')) YYERROR;
484            }
485          }
486        | '[' exprlist ']'
487          {
488            if (currRingHdl==NULL) MYYERROR("no ring active");
489            int j = 0;
490            memset(&$$,0,sizeof(sleftv));
491            $$.rtyp=VECTOR_CMD;
492            leftv v = &$2;
493            while (v!=NULL)
494            {
495              int i,t;
496              sleftv tmp;
497              memset(&tmp,0,sizeof(tmp));
498              i=iiTestConvert((t=v->Typ()),POLY_CMD);
499              if((i==0) || (iiConvert(t /*v->Typ()*/,POLY_CMD,i,v,&tmp)))
500              {
501                pDelete((poly *)&$$.data);
502                $2.CleanUp();
503                MYYERROR("expected '[poly,...'");
504              }
505              poly p = (poly)tmp.CopyD(POLY_CMD);
506              pSetCompP(p,++j);
507              $$.data = (void *)pAdd((poly)$$.data,p);
508              v->next=tmp.next;tmp.next=NULL;
509              tmp.CleanUp();
510              v=v->next;
511            }
512            $2.CleanUp();
513          }
514        | INT_CONST
515          {
516            memset(&$$,0,sizeof($$));
517            int i = atoi($1);
518            /*remember not to omFree($1)
519            *because it is a part of the scanner buffer*/
520            $$.rtyp  = INT_CMD;
521            $$.data = (void *)i;
522
523            /* check: out of range input */
524            int l = strlen($1)+2;
525            if (l >= MAX_INT_LEN)
526            {
527              char tmp[MAX_INT_LEN+5];
528              sprintf(tmp,"%d",i);
529              if (strcmp(tmp,$1)!=0)
530              {
531                if (currRing==NULL)
532                {
533                  Werror("`%s` greater than %d(max. integer representation)"
534                         ,$1,MAX_INT_VAL);
535                  YYERROR;
536                }
537                char *t1=omStrDup($1);
538                syMake(&$$,t1);
539              }
540            }
541          }
542        | SYSVAR
543          {
544            memset(&$$,0,sizeof($$));
545            $$.rtyp = $1;
546            $$.data = $$.Data();
547          }
548        | stringexpr
549          {
550            memset(&$$,0,sizeof($$));
551            $$.rtyp  = STRING_CMD;
552            $$.data = $1;
553          }
554        ;
555
556exprlist:
557        expr ',' exprlist
558          {
559            leftv v = &$1;
560            while (v->next!=NULL)
561            {
562              v=v->next;
563            }
564            v->next = (leftv)omAllocBin(sleftv_bin);
565            memcpy(v->next,&($3),sizeof(sleftv));
566            $$ = $1;
567          }
568        | expr
569          {
570            $$ = $1;
571          }
572        ;
573
574expr:   expr_arithmetic
575          {
576            /*if ($1.typ == eunknown) YYERROR;*/
577            $$ = $1;
578          }
579        | elemexpr       { $$ = $1; }
580        | '(' exprlist ')'    { $$ = $2; }
581        | expr '[' expr ',' expr ']'
582          {
583            if(iiExprArith3(&$$,'[',&$1,&$3,&$5)) YYERROR;
584          }
585        | expr '[' expr ']'
586          {
587            if(iiExprArith2(&$$,&$1,'[',&$3)) YYERROR;
588          }
589        | ROOT_DECL '(' expr ')'
590          {
591            if(iiExprArith1(&$$,&$3,$1)) YYERROR;
592          }
593        | ROOT_DECL_LIST '(' exprlist ')'
594          {
595            if(iiExprArithM(&$$,&$3,$1)) YYERROR;
596          }
597        | ROOT_DECL_LIST '(' ')'
598          {
599            if(iiExprArithM(&$$,NULL,$1)) YYERROR;
600          }
601        | RING_DECL '(' expr ')'
602          {
603            if(iiExprArith1(&$$,&$3,$1)) YYERROR;
604          }
605        | currring_lists '(' exprlist ')'
606          {
607            if(iiExprArithM(&$$,&$3,$1)) YYERROR;
608          }
609        | currring_lists '(' ')'
610          {
611            if(iiExprArithM(&$$,NULL,$1)) YYERROR;
612          }
613        | CMD_1 '(' expr ')'
614          {
615            if(iiExprArith1(&$$,&$3,$1)) YYERROR;
616          }
617        | CMD_2 '(' expr ',' expr ')'
618          {
619            if(iiExprArith2(&$$,&$3,$1,&$5,TRUE)) YYERROR;
620          }
621        | CMD_3 '(' expr ',' expr ',' expr ')'
622          {
623            if(iiExprArith3(&$$,$1,&$3,&$5,&$7)) YYERROR;
624          }
625        | CMD_23 '(' expr ',' expr ')'
626          {
627            if(iiExprArith2(&$$,&$3,$1,&$5,TRUE)) YYERROR;
628          }
629        | CMD_23 '(' expr ',' expr ',' expr ')'
630          {
631            if(iiExprArith3(&$$,$1,&$3,&$5,&$7)) YYERROR;
632          }
633        | CMD_12 '(' expr ')'
634          {
635            if(iiExprArith1(&$$,&$3,$1)) YYERROR;
636          }
637        | CMD_13 '(' expr ')'
638          {
639            if(iiExprArith1(&$$,&$3,$1)) YYERROR;
640          }
641        | CMD_12 '(' expr ',' expr ')'
642          {
643            if(iiExprArith2(&$$,&$3,$1,&$5,TRUE)) YYERROR;
644          }
645        | CMD_123 '(' expr ')'
646          {
647            if(iiExprArith1(&$$,&$3,$1)) YYERROR;
648          }
649        | CMD_123 '(' expr ',' expr ')'
650          {
651            if(iiExprArith2(&$$,&$3,$1,&$5,TRUE)) YYERROR;
652          }
653        | CMD_13 '(' expr ',' expr ',' expr ')'
654          {
655            if(iiExprArith3(&$$,$1,&$3,&$5,&$7)) YYERROR;
656          }
657        | CMD_123 '(' expr ',' expr ',' expr ')'
658          {
659            if(iiExprArith3(&$$,$1,&$3,&$5,&$7)) YYERROR;
660          }
661        | CMD_M '(' ')'
662          {
663            if(iiExprArithM(&$$,NULL,$1)) YYERROR;
664          }
665        | CMD_M '(' exprlist ')'
666          {
667            if(iiExprArithM(&$$,&$3,$1)) YYERROR;
668          }
669        | MATRIX_CMD '(' expr ',' expr ',' expr ')'
670          {
671            if(iiExprArith3(&$$,MATRIX_CMD,&$3,&$5,&$7)) YYERROR;
672          }
673        | MATRIX_CMD '(' expr ')'
674          {
675            if(iiExprArith1(&$$,&$3,MATRIX_CMD)) YYERROR;
676          }
677        | INTMAT_CMD '(' expr ',' expr ',' expr ')'
678          {
679            if(iiExprArith3(&$$,INTMAT_CMD,&$3,&$5,&$7)) YYERROR;
680          }
681        | INTMAT_CMD '(' expr ')'
682          {
683            if(iiExprArith1(&$$,&$3,INTMAT_CMD)) YYERROR;
684          }
685        | RING_CMD '(' rlist ',' rlist ',' ordering ')'
686          {
687            if(iiExprArith3(&$$,RING_CMD,&$3,&$5,&$7)) YYERROR;
688          }
689        | RING_CMD '(' expr ')'
690          {
691            if(iiExprArith1(&$$,&$3,RING_CMD)) YYERROR;
692          }
693        | quote_start expr quote_end
694          {
695            $$=$2;
696          }
697        | quote_start expr '=' expr quote_end
698          {
699            #ifdef SIQ
700            siq++;
701            if (siq>0)
702            { if (iiExprArith2(&$$,&$2,'=',&$4)) YYERROR; }
703            else
704            #endif
705            {
706              memset(&$$,0,sizeof($$));
707              $$.rtyp=NONE;
708              if (iiAssign(&$2,&$4)) YYERROR;
709            }
710            #ifdef SIQ
711            siq--;
712            #endif
713          }
714        | EVAL  '('
715          {
716            #ifdef SIQ
717            siq--;
718            #endif
719          }
720          expr ')'
721          {
722            #ifdef SIQ
723            if (siq<=0) $4.Eval();
724            #endif
725            $$=$4;
726            #ifdef SIQ
727            siq++;
728            #endif
729          }
730          ;
731
732quote_start:    QUOTE  '('
733          {
734            #ifdef SIQ
735            siq++;
736            #endif
737          }
738          ;
739
740quote_end: ')'
741          {
742            #ifdef SIQ
743            siq--;
744            #endif
745          }
746          ;
747
748expr_arithmetic:
749          expr PLUSPLUS     %prec PLUSPLUS
750          {
751            if(iiExprArith1(&$$,&$1,PLUSPLUS)) YYERROR;
752          }
753        | expr MINUSMINUS   %prec MINUSMINUS
754          {
755            if(iiExprArith1(&$$,&$1,MINUSMINUS)) YYERROR;
756          }
757        | expr '+' expr
758          {
759            if(iiExprArith2(&$$,&$1,'+',&$3)) YYERROR;
760          }
761        | expr '-' expr
762          {
763            if(iiExprArith2(&$$,&$1,'-',&$3)) YYERROR;
764          }
765        | expr '/' expr
766          {
767            if(iiExprArith2(&$$,&$1,$<i>2,&$3)) YYERROR;
768          }
769        | expr '^' expr
770          {
771            if(iiExprArith2(&$$,&$1,'^',&$3)) YYERROR;
772          }
773        | expr '<' expr
774          {
775            if(iiExprArith2(&$$,&$1,$<i>2,&$3)) YYERROR;
776          }
777        | expr '&' expr
778          {
779            if(iiExprArith2(&$$,&$1,$<i>2,&$3)) YYERROR;
780          }
781        | expr NOTEQUAL expr
782          {
783            if(iiExprArith2(&$$,&$1,NOTEQUAL,&$3)) YYERROR;
784          }
785        | expr EQUAL_EQUAL expr
786          {
787            if(iiExprArith2(&$$,&$1,EQUAL_EQUAL,&$3)) YYERROR;
788          }
789        | expr DOTDOT expr
790          {
791            if(iiExprArith2(&$$,&$1,DOTDOT,&$3)) YYERROR;
792          }
793        | NOT expr
794          {
795            memset(&$$,0,sizeof($$));
796            int i; TESTSETINT($2,i);
797            $$.rtyp  = INT_CMD;
798            $$.data = (void *)(i == 0 ? 1 : 0);
799          }
800        | '-' expr %prec UMINUS
801          {
802            if(iiExprArith1(&$$,&$2,'-')) YYERROR;
803          }
804        ;
805
806left_value:
807        declare_ip_variable cmdeq  { $$ = $1; }
808        | exprlist '='
809          {
810            if ($1.rtyp==0)
811            {
812              Werror("`%s` is undefined",$1.Fullname());
813              YYERROR;
814            }
815            $$ = $1;
816          }
817        ;
818
819
820extendedid:
821        UNKNOWN_IDENT
822        | '`' expr '`'
823          {
824            if ($2.Typ()!=STRING_CMD)
825            {
826              MYYERROR("string expression expected");
827            }
828            $$ = (char *)$2.CopyD(STRING_CMD);
829            $2.CleanUp();
830          }
831        ;
832
833currring_lists:
834        IDEAL_CMD | MODUL_CMD
835        /* put variables into the current ring */
836        ;
837
838declare_ip_variable:
839        ROOT_DECL elemexpr
840          {
841            if (iiDeclCommand(&$$,&$2,myynest,$1,&IDROOT)) YYERROR;
842          }
843        | ROOT_DECL_LIST elemexpr
844          {
845            if (iiDeclCommand(&$$,&$2,myynest,$1,&IDROOT)) YYERROR;
846          }
847        | RING_DECL elemexpr
848          {
849            if (iiDeclCommand(&$$,&$2,myynest,$1,&(currRing->idroot), TRUE)) YYERROR;
850          }
851        | currring_lists elemexpr
852          {
853            if (iiDeclCommand(&$$,&$2,myynest,$1,&(currRing->idroot), TRUE)) YYERROR;
854          }
855        | MATRIX_CMD elemexpr '[' expr ']' '[' expr ']'
856          {
857            if (iiDeclCommand(&$$,&$2,myynest,$1,&(currRing->idroot), TRUE)) YYERROR;
858            int r; TESTSETINT($4,r);
859            int c; TESTSETINT($7,c);
860            if (r < 1)
861              MYYERROR("rows must be greater than 0");
862            if (c < 0)
863              MYYERROR("cols must be greater than -1");
864            leftv v=&$$;
865            //while (v->next!=NULL) { v=v->next; }
866            idhdl h=(idhdl)v->data;
867            idDelete(&IDIDEAL(h));
868            IDMATRIX(h) = mpNew(r,c);
869            if (IDMATRIX(h)==NULL) YYERROR;
870          }
871        | MATRIX_CMD elemexpr
872          {
873            if (iiDeclCommand(&$$,&$2,myynest,$1,&(currRing->idroot), TRUE)) YYERROR;
874          }
875        | INTMAT_CMD elemexpr '[' expr ']' '[' expr ']'
876          {
877            if (iiDeclCommand(&$$,&$2,myynest,$1,&IDROOT)) YYERROR;
878            int r; TESTSETINT($4,r);
879            int c; TESTSETINT($7,c);
880            if (r < 1)
881              MYYERROR("rows must be greater than 0");
882            if (c < 0)
883              MYYERROR("cols must be greater than -1");
884            leftv v=&$$;
885            //while (v->next!=NULL) { v=v->next; }
886            idhdl h=(idhdl)v->data;
887            delete IDINTVEC(h);
888            IDINTVEC(h) = new intvec(r,c,0);
889            if (IDINTVEC(h)==NULL) YYERROR;
890          }
891        | INTMAT_CMD elemexpr
892          {
893            if (iiDeclCommand(&$$,&$2,myynest,$1,&IDROOT)) YYERROR;
894            leftv v=&$$;
895            idhdl h;
896            do
897            {
898               h=(idhdl)v->data;
899               delete IDINTVEC(h);
900               IDINTVEC(h) = new intvec(1,1,0);
901               v=v->next;
902            } while (v!=NULL);
903          }
904        | declare_ip_variable ',' elemexpr
905          {
906            int t=$1.Typ();
907            sleftv r;
908            memset(&r,0,sizeof(sleftv));
909            if ((BEGIN_RING<t) && (t<END_RING))
910            {
911              if (iiDeclCommand(&r,&$3,myynest,t,&(currRing->idroot), TRUE)) YYERROR;
912            }
913            else
914            {
915              if (iiDeclCommand(&r,&$3,myynest,t,&IDROOT)) YYERROR;
916            }
917            leftv v=&$1;
918            while (v->next!=NULL) v=v->next;
919            v->next=(leftv)omAllocBin(sleftv_bin);
920            memcpy(v->next,&r,sizeof(sleftv));
921            $$=$1;
922          }
923        | PROC_CMD elemexpr
924          {
925            if (iiDeclCommand(&$$,&$2,myynest,PROC_CMD,&IDROOT, FALSE, TRUE)) YYERROR;
926          }
927        ;
928
929stringexpr:
930        STRINGTOK
931        ;
932
933rlist:
934        expr
935        | '(' expr ',' exprlist ')'
936          {
937            leftv v = &$2;
938            while (v->next!=NULL)
939            {
940              v=v->next;
941            }
942            v->next = (leftv)omAllocBin(sleftv_bin);
943            memcpy(v->next,&($4),sizeof(sleftv));
944            $$ = $2;
945          }
946        ;
947
948ordername:
949        UNKNOWN_IDENT
950        {
951          // let rInit take care of any errors
952          $$=rOrderName($1);
953        }
954        ;
955
956orderelem:
957        ordername
958          {
959            memset(&$$,0,sizeof($$));
960            intvec *iv = new intvec(2);
961            (*iv)[0] = 1;
962            (*iv)[1] = $1;
963            $$.rtyp = INTVEC_CMD;
964            $$.data = (void *)iv;
965          }
966        | ordername '(' exprlist ')'
967          {
968            memset(&$$,0,sizeof($$));
969            leftv sl = &$3;
970            int slLength;
971            {
972              slLength =  exprlist_length(sl);
973              int l = 2 +  slLength;
974              intvec *iv = new intvec(l);
975              (*iv)[0] = slLength;
976              (*iv)[1] = $1;
977
978              int i = 2;
979              while ((i<l) && (sl!=NULL))
980              {
981                if (sl->Typ() == INT_CMD)
982                {
983                  (*iv)[i++] = (int)(sl->Data());
984                }
985                else if ((sl->Typ() == INTVEC_CMD)
986                ||(sl->Typ() == INTMAT_CMD))
987                {
988                  intvec *ivv = (intvec *)(sl->Data());
989                  int ll = 0,l = ivv->length();
990                  for (; l>0; l--)
991                  {
992                    (*iv)[i++] = (*ivv)[ll++];
993                  }
994                }
995                else
996                {
997                  delete iv;
998                  $3.CleanUp();
999                  MYYERROR("wrong type in ordering");
1000                }
1001                sl = sl->next;
1002              }
1003              $$.rtyp = INTVEC_CMD;
1004              $$.data = (void *)iv;
1005            }
1006            $3.CleanUp();
1007          }
1008        ;
1009
1010OrderingList:
1011        orderelem
1012        |  orderelem ',' OrderingList
1013          {
1014            $$ = $1;
1015            $$.next = (sleftv *)omAllocBin(sleftv_bin);
1016            memcpy($$.next,&$3,sizeof(sleftv));
1017          }
1018        ;
1019
1020ordering:
1021        orderelem
1022        | '(' OrderingList ')'
1023          {
1024            $$ = $2;
1025          }
1026        ;
1027
1028cmdeq:  '='
1029          {
1030            expected_parms = TRUE;
1031          }
1032        ;
1033
1034
1035/* --------------------------------------------------------------------*/
1036/* section of pure commands                                            */
1037/* --------------------------------------------------------------------*/
1038
1039filecmd:
1040        '<' stringexpr
1041          { if ($<i>1 != '<') YYERROR;
1042            if((feFilePending=feFopen($2,"r",NULL,TRUE))==NULL) YYERROR; }
1043        ';'
1044          { newFile($2,feFilePending); }
1045        ;
1046
1047helpcmd:
1048        HELP_CMD STRINGTOK ';'
1049          {
1050            feHelp($2);
1051            omFree((ADDRESS)$2);
1052          }
1053        | HELP_CMD ';'
1054          {
1055            feHelp(NULL);
1056          }
1057        ;
1058
1059examplecmd:
1060        EXAMPLE_CMD STRINGTOK ';'
1061          {
1062            singular_example($2);
1063            omFree((ADDRESS)$2);
1064          }
1065       ;
1066
1067exportcmd:
1068        EXPORT_CMD exprlist
1069        {
1070#ifdef HAVE_NAMESPACES
1071          if (iiExport(&$2,0,namespaceroot->get("Top",0,TRUE))) YYERROR;
1072#else /* HAVE_NAMESPACES */
1073          if (iiExport(&$2,0)) YYERROR;
1074#endif /* HAVE_NAMESPACES */
1075            }
1076        | EXPORT_CMD exprlist extendedid expr
1077        {
1078          if ((strcmp($3,"to")!=0) ||
1079          (($4.Typ()!=PACKAGE_CMD) && ($4.Typ()!=INT_CMD) &&
1080           ($4.Typ()!=STRING_CMD)))
1081            MYYERROR("export <id> to <package|int>");
1082          omFree((ADDRESS)$3);
1083          if ($4.Typ()==INT_CMD)
1084          {
1085            if (iiExport(&$2,((int)$4.Data())-1)) YYERROR;
1086          }
1087          else
1088          {
1089#ifdef HAVE_NAMESPACES
1090            if (($4.Typ()==PACKAGE_CMD)
1091            && (iiExport(&$2,0,(idhdl)$4.data)))
1092              YYERROR;
1093#else           
1094            printf("String: %s;\n", (char *)$4.data);
1095#endif /* HAVE_NAMESPACES */
1096          }
1097        }
1098        ;
1099
1100killcmd:
1101        KILL_CMD exprlist
1102        {
1103          leftv v=&$2;
1104          do
1105          {
1106            if (v->rtyp!=IDHDL)
1107            {
1108              if (v->name!=NULL) Werror("`%s` is undefined in kill",v->name);
1109              else               WerrorS("kill what ?");
1110            }
1111            else
1112            {
1113            #ifdef HAVE_NAMESPACES
1114              if (v->packhdl != NULL)
1115              {
1116                namespaceroot->push( IDPACKAGE(v->packhdl) , IDID(v->packhdl));
1117                killhdl((idhdl)v->data);
1118                namespaceroot->pop();
1119              }
1120              else
1121              #endif /* HAVE_NAMESPACES */
1122                killhdl((idhdl)v->data);
1123            }
1124            v=v->next;
1125          } while (v!=NULL);
1126          $2.CleanUp();
1127        }
1128        ;
1129
1130listcmd:
1131        LISTVAR_CMD '(' ROOT_DECL ')'
1132          {
1133            list_cmd($3,NULL,"// ",TRUE);
1134          }
1135        | LISTVAR_CMD '(' ROOT_DECL_LIST ')'
1136          {
1137            list_cmd($3,NULL,"// ",TRUE);
1138          }
1139        | LISTVAR_CMD '(' RING_DECL ')'
1140          {
1141            if ($3==QRING_CMD) $3=RING_CMD;
1142            list_cmd($3,NULL,"// ",TRUE);
1143          }
1144        | LISTVAR_CMD '(' currring_lists ')'
1145          {
1146            list_cmd($3,NULL,"// ",TRUE);
1147          }
1148        | LISTVAR_CMD '(' RING_CMD ')'
1149          {
1150            list_cmd(RING_CMD,NULL,"// ",TRUE);
1151          }
1152        | LISTVAR_CMD '(' MATRIX_CMD ')'
1153          {
1154            list_cmd(MATRIX_CMD,NULL,"// ",TRUE);
1155           }
1156        | LISTVAR_CMD '(' INTMAT_CMD ')'
1157          {
1158            list_cmd(INTMAT_CMD,NULL,"// ",TRUE);
1159          }
1160        | LISTVAR_CMD '(' PROC_CMD ')'
1161          {
1162            list_cmd(PROC_CMD,NULL,"// ",TRUE);
1163          }
1164        | LISTVAR_CMD '(' elemexpr ')'
1165          {
1166#ifdef HAVE_NAMESPACES
1167            if($3.Typ() == PACKAGE_CMD) {
1168              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1169                                   ((sleftv)$3).name);
1170              list_cmd(-2,NULL,"// ",TRUE);
1171              namespaceroot->pop();
1172            }
1173            else
1174#endif /* HAVE_NAMESPACES */
1175              list_cmd(0,$3.Fullname(),"// ",TRUE);
1176            $3.CleanUp();
1177          }
1178        | LISTVAR_CMD '(' elemexpr ',' ROOT_DECL ')'
1179          {
1180#ifdef HAVE_NAMESPACES
1181            if($3.Typ() == PACKAGE_CMD) {
1182              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1183                                   ((sleftv)$3).name);
1184              list_cmd($5,NULL,"// ",TRUE);
1185              namespaceroot->pop();
1186            }
1187#endif /* HAVE_NAMESPACES */
1188            $3.CleanUp();
1189          }
1190        | LISTVAR_CMD '(' elemexpr ',' ROOT_DECL_LIST ')'
1191          {
1192#ifdef HAVE_NAMESPACES
1193            if($3.Typ() == PACKAGE_CMD) {
1194              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1195                                   ((sleftv)$3).name);
1196              list_cmd($5,NULL,"// ",TRUE);
1197              namespaceroot->pop();
1198            }
1199#endif /* HAVE_NAMESPACES */
1200            $3.CleanUp();
1201          }
1202        | LISTVAR_CMD '(' elemexpr ',' RING_DECL ')'
1203          {
1204#ifdef HAVE_NAMESPACES
1205            if($3.Typ() == PACKAGE_CMD) {
1206              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1207                                   ((sleftv)$3).name);
1208              if ($5==QRING_CMD) $5=RING_CMD;
1209              list_cmd($5,NULL,"// ",TRUE);
1210              namespaceroot->pop();
1211            }
1212#endif /* HAVE_NAMESPACES */
1213            $3.CleanUp();
1214          }
1215        | LISTVAR_CMD '(' elemexpr ',' currring_lists ')'
1216          {
1217#ifdef HAVE_NAMESPACES
1218            if($3.Typ() == PACKAGE_CMD) {
1219              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1220                                   ((sleftv)$3).name);
1221              list_cmd($5,NULL,"// ",TRUE);
1222              namespaceroot->pop();
1223            }
1224#endif /* HAVE_NAMESPACES */
1225            $3.CleanUp();
1226          }
1227        | LISTVAR_CMD '(' elemexpr ',' RING_CMD ')'
1228          {
1229#ifdef HAVE_NAMESPACES
1230            if($3.Typ() == PACKAGE_CMD) {
1231              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1232                                   ((sleftv)$3).name);
1233              list_cmd(RING_CMD,NULL,"// ",TRUE);
1234              namespaceroot->pop();
1235            }
1236#endif /* HAVE_NAMESPACES */
1237            $3.CleanUp();
1238          }
1239        | LISTVAR_CMD '(' elemexpr ',' MATRIX_CMD ')'
1240          {
1241#ifdef HAVE_NAMESPACES
1242            if($3.Typ() == PACKAGE_CMD) {
1243              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1244                                   ((sleftv)$3).name);
1245              list_cmd(MATRIX_CMD,NULL,"// ",TRUE);
1246              namespaceroot->pop();
1247            }
1248#endif /* HAVE_NAMESPACES */
1249            $3.CleanUp();
1250          }
1251        | LISTVAR_CMD '(' elemexpr ',' INTMAT_CMD ')'
1252          {
1253#ifdef HAVE_NAMESPACES
1254            if($3.Typ() == PACKAGE_CMD) {
1255              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1256                                   ((sleftv)$3).name);
1257              list_cmd(INTMAT_CMD,NULL,"// ",TRUE);
1258              namespaceroot->pop();
1259            }
1260#endif /* HAVE_NAMESPACES */
1261            $3.CleanUp();
1262          }
1263        | LISTVAR_CMD '(' elemexpr ',' PROC_CMD ')'
1264          {
1265#ifdef HAVE_NAMESPACES
1266            if($3.Typ() == PACKAGE_CMD) {
1267              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1268                                   ((sleftv)$3).name);
1269              list_cmd(PROC_CMD,$3.Fullname(),"// ",TRUE);
1270              namespaceroot->pop();
1271            }
1272#endif /* HAVE_NAMESPACES */
1273            $3.CleanUp();
1274          }
1275        | LISTVAR_CMD '(' elemexpr ',' elemexpr ')'
1276          {
1277#ifdef HAVE_NAMESPACES
1278            if($3.Typ() == PACKAGE_CMD) {
1279              namespaceroot->push( IDPACKAGE((idhdl)$3.data),
1280                                   ((sleftv)$3).name);
1281              list_cmd(0,$5.Fullname(),"// ",TRUE);
1282              namespaceroot->pop();
1283            }
1284#endif /* HAVE_NAMESPACES */
1285            $3.CleanUp();
1286          }
1287        | LISTVAR_CMD '(' ')'
1288          {
1289            list_cmd(-1,NULL,"// ",TRUE);
1290          }
1291        ;
1292
1293ringcmd1:
1294       RING_CMD { yyInRingConstruction = TRUE; }
1295       ;
1296
1297ringcmd:
1298        ringcmd1
1299          elemexpr cmdeq
1300          rlist     ','      /* description of coeffs */
1301          rlist     ','      /* var names */
1302          ordering           /* list of (multiplier ordering (weight(s))) */
1303          {
1304            BOOLEAN do_pop = FALSE;
1305            char *ring_name = $2.name;
1306            #ifdef HAVE_NAMESPACES
1307              if (((sleftv)$2).req_packhdl != NULL)
1308              {
1309                namespaceroot->push( IDPACKAGE(((sleftv)$2).req_packhdl) , "");
1310                do_pop = TRUE;
1311                if( (((sleftv)$2).req_packhdl != NULL) &&
1312                    (((sleftv)$2).packhdl != ((sleftv)$2).req_packhdl))
1313                  ring_name = omStrDup($2.name);
1314              }
1315            #endif /* HAVE_NAMESPACES */
1316            ring b=
1317            rInit(&$4,            /* characteristik and list of parameters*/
1318                  &$6,            /* names of ringvariables */
1319                  &$8);            /* ordering */
1320            idhdl newRingHdl=NULL;
1321            if (b!=NULL)
1322            {
1323              newRingHdl=enterid(ring_name, myynest, RING_CMD, &IDROOT);
1324              if (newRingHdl!=NULL)
1325              {
1326                omFreeSize(IDRING(newRingHdl),sizeof(ip_sring));
1327                IDRING(newRingHdl)=b;
1328              }
1329              else
1330              {
1331                rKill(b);
1332              }
1333            }
1334            #ifdef HAVE_NAMESPACES
1335              if(do_pop) namespaceroot->pop();
1336            #endif /* HAVE_NAMESPACES */
1337            yyInRingConstruction = FALSE;
1338            if (newRingHdl==NULL)
1339            {
1340              MYYERROR("cannot make ring");
1341            }
1342            else
1343            {
1344              rSetHdl(newRingHdl);
1345            }
1346          }
1347        | ringcmd1 elemexpr
1348          {
1349            BOOLEAN do_pop = FALSE;
1350            char *ring_name = $2.name;
1351            #ifdef HAVE_NAMESPACES
1352              if (((sleftv)$2).req_packhdl != NULL)
1353              {
1354                namespaceroot->push( IDPACKAGE(((sleftv)$2).req_packhdl) , "");
1355                do_pop = TRUE;
1356                if( (((sleftv)$2).req_packhdl != NULL) &&
1357                  (((sleftv)$2).packhdl != ((sleftv)$2).req_packhdl))
1358                  ring_name = omStrDup($2.name);
1359              }
1360            #endif /* HAVE_NAMESPACES */
1361            if (!inerror) rDefault(ring_name);
1362            #ifdef HAVE_NAMESPACES
1363              if(do_pop) namespaceroot->pop();
1364            #endif /* HAVE_NAMESPACES */
1365            yyInRingConstruction = FALSE;
1366          }
1367        ;
1368
1369scriptcmd:
1370         SYSVAR stringexpr
1371          {
1372          #ifndef HAVE_NAMESPACES
1373            if (($1!=LIB_CMD)||(iiLibCmd($2)))
1374          #endif 
1375            YYERROR;
1376          }
1377        ;
1378
1379setrings:  SETRING_CMD | KEEPRING_CMD ;
1380
1381setringcmd:
1382        setrings expr
1383          {
1384            if (($1==KEEPRING_CMD) && (myynest==0))
1385               MYYERROR("only inside a proc allowed");
1386            const char * n=$2.Name();
1387            if ((($2.Typ()==RING_CMD)||($2.Typ()==QRING_CMD))
1388            && ($2.rtyp==IDHDL))
1389            {
1390              idhdl h=(idhdl)$2.data;
1391              if ($2.e!=NULL) h=rFindHdl((ring)$2.Data(),NULL, NULL);
1392              if ($1==KEEPRING_CMD)
1393              {
1394                if (h!=NULL)
1395                {
1396                  if (IDLEV(h)!=0)
1397                  {
1398#ifdef HAVE_NAMESPACES
1399                    if(namespaceroot->isroot) {
1400                      if (iiExport(&$2,myynest-1)) YYERROR;
1401                    } else {
1402                      if (iiExport(&$2,myynest-1,
1403                        namespaceroot->get(namespaceroot->next->name,0,TRUE)))
1404                        YYERROR;
1405                    }
1406#else /* HAVE_NAMESPACES */
1407                    if (iiExport(&$2,myynest-1)) YYERROR;
1408#endif /* HAVE_NAMESPACES */
1409                    //if (TEST_OPT_KEEPVARS)
1410                    //{
1411                      idhdl p=IDRING(h)->idroot;
1412                      idhdl root=p;
1413                      int prevlev=myynest-1;
1414                      while (p!=NULL)
1415                      {
1416                        if (IDLEV(p)==myynest)
1417                        {
1418                          idhdl old=root->get(IDID(p),prevlev);
1419                          if (old!=NULL)
1420                          {
1421                            if (BVERBOSE(V_REDEFINE))
1422                              Warn("redefining %s",IDID(p));
1423                            killhdl(old,&root);
1424                          }
1425                          IDLEV(p)=prevlev;
1426                        }
1427                        p=IDNEXT(p);
1428                      }
1429                    //}
1430                  }
1431#ifdef USE_IILOCALRING
1432                  iiLocalRing[myynest-1]=IDRING(h);
1433#else
1434                  namespaceroot->next->currRing=IDRING(h);
1435#endif
1436                }
1437                else
1438                {
1439                  Werror("%s is no identifier",n);
1440                  $2.CleanUp();
1441                  YYERROR;
1442                }
1443              }
1444              if (h!=NULL) rSetHdl(h);
1445              else
1446              {
1447                Werror("cannot find the name of the basering %s",n);
1448                $2.CleanUp();
1449                YYERROR;
1450              }
1451              $2.CleanUp();
1452            }
1453            else
1454            {
1455              Werror("%s is no name of a ring/qring",n);
1456              $2.CleanUp();
1457              YYERROR;
1458            }
1459          }
1460        ;
1461
1462typecmd:
1463        TYPE_CMD expr
1464          {
1465            if ($2.rtyp!=IDHDL) MYYERROR("identifier expected");
1466            idhdl h = (idhdl)$2.data;
1467            type_cmd(h);
1468          }
1469        | exprlist
1470          {
1471            //Print("typ is %d, rtyp:%d\n",$1.Typ(),$1.rtyp);
1472            #ifdef SIQ
1473            if ($1.rtyp!=COMMAND)
1474            {
1475            #endif
1476              if ($1.Typ()==UNKNOWN)
1477              {
1478                if ($1.name!=NULL)
1479                {
1480                  Werror("`%s` is undefined",$1.name);
1481                  omFree((ADDRESS)$1.name);
1482                }
1483                YYERROR;
1484              }
1485            #ifdef SIQ
1486            }
1487            #endif
1488            $1.Print(&sLastPrinted);
1489            $1.CleanUp();
1490            if (errorreported) YYERROR;
1491          }
1492        ;
1493
1494/* --------------------------------------------------------------------*/
1495/* section of flow control                                             */
1496/* --------------------------------------------------------------------*/
1497
1498ifcmd: IF_CMD '(' expr ')' BLOCKTOK
1499          {
1500            int i; TESTSETINT($3,i);
1501            if (i!=0)
1502            {
1503              newBuffer( $5, BT_if);
1504            }
1505            else
1506            {
1507              omFree((ADDRESS)$5);
1508              currentVoice->ifsw=1;
1509            }
1510          }
1511        | ELSE_CMD BLOCKTOK
1512          {
1513            if (currentVoice->ifsw==1)
1514            {
1515              currentVoice->ifsw=0;
1516              newBuffer( $2, BT_else);
1517            }
1518            else
1519            {
1520              if (currentVoice->ifsw!=2)
1521              {
1522                Warn("`else` without `if` in level %d",myynest);
1523              }
1524              omFree((ADDRESS)$2);
1525            }
1526            currentVoice->ifsw=0;
1527          }
1528        | IF_CMD '(' expr ')' BREAK_CMD
1529          {
1530            int i; TESTSETINT($3,i);
1531            if (i)
1532            {
1533              if (exitBuffer(BT_break)) YYERROR;
1534            }
1535            currentVoice->ifsw=0;
1536          }
1537        | BREAK_CMD
1538          {
1539            if (exitBuffer(BT_break)) YYERROR;
1540            currentVoice->ifsw=0;
1541          }
1542        | CONTINUE_CMD
1543          {
1544            if (contBuffer(BT_break)) YYERROR;
1545            currentVoice->ifsw=0;
1546          }
1547      ;
1548
1549whilecmd:
1550        WHILE_CMD STRINGTOK BLOCKTOK
1551          {
1552            /* -> if(!$2) break; $3; continue;*/
1553            char * s = (char *)omAlloc( strlen($2) + strlen($3) + 36);
1554            sprintf(s,"whileif (!(%s)) break;\n%scontinue;\n " ,$2,$3);
1555            newBuffer(s,BT_break);
1556            omFree((ADDRESS)$2);
1557            omFree((ADDRESS)$3);
1558          }
1559        ;
1560
1561forcmd:
1562        FOR_CMD STRINGTOK STRINGTOK STRINGTOK BLOCKTOK
1563          {
1564            /* $2 */
1565            /* if (!$3) break; $5; $4; continue; */
1566            char * s = (char *)omAlloc( strlen($3)+strlen($4)+strlen($5)+36);
1567            sprintf(s,"forif (!(%s)) break;\n%s%s;\ncontinue;\n "
1568                   ,$3,$5,$4);
1569            omFree((ADDRESS)$3);
1570            omFree((ADDRESS)$4);
1571            omFree((ADDRESS)$5);
1572            newBuffer(s,BT_break);
1573            s = (char *)omAlloc( strlen($2) + 3);
1574            sprintf(s,"%s;\n",$2);
1575            omFree((ADDRESS)$2);
1576            newBuffer(s,BT_if);
1577          }
1578        ;
1579
1580proccmd:
1581        PROC_CMD extendedid BLOCKTOK
1582          {
1583            procinfov pi;
1584            idhdl h = enterid($2,myynest,PROC_CMD,&IDROOT,TRUE);
1585            if (h==NULL) {omFree((ADDRESS)$3); YYERROR;}
1586            iiInitSingularProcinfo(IDPROC(h),"", $2, 0, 0);
1587            IDPROC(h)->data.s.body = (char *)omAlloc(strlen($3)+31);;
1588            sprintf(IDPROC(h)->data.s.body,"parameter list #;\n%s;return();\n\n",$3);
1589            omFree((ADDRESS)$3);
1590          }
1591        | PROC_DEF STRINGTOK BLOCKTOK
1592          {
1593            idhdl h = enterid($1,myynest,PROC_CMD,&IDROOT,TRUE);
1594            if (h==NULL)
1595            {
1596              omFree((ADDRESS)$2);
1597              omFree((ADDRESS)$3);
1598              YYERROR;
1599            }
1600            char *args=iiProcArgs($2,FALSE);
1601            omFree((ADDRESS)$2);
1602            procinfov pi;
1603            iiInitSingularProcinfo(IDPROC(h),"", $1, 0, 0);
1604            IDPROC(h)->data.s.body = (char *)omAlloc(strlen($3)+strlen(args)+14);;
1605            sprintf(IDPROC(h)->data.s.body,"%s\n%s;return();\n\n",args,$3);
1606            omFree((ADDRESS)args);
1607            omFree((ADDRESS)$3);
1608          }
1609        | PROC_DEF STRINGTOK STRINGTOK BLOCKTOK
1610          {
1611            omFree((ADDRESS)$3);
1612            idhdl h = enterid($1,myynest,PROC_CMD,&IDROOT,TRUE);
1613            if (h==NULL)
1614            {
1615              omFree((ADDRESS)$2);
1616              omFree((ADDRESS)$4);
1617              YYERROR;
1618            }
1619            char *args=iiProcArgs($2,FALSE);
1620            omFree((ADDRESS)$2);
1621            procinfov pi;
1622            iiInitSingularProcinfo(IDPROC(h),"", $1, 0, 0);
1623            IDPROC(h)->data.s.body = (char *)omAlloc(strlen($4)+strlen(args)+14);;
1624            sprintf(IDPROC(h)->data.s.body,"%s\n%s;return();\n\n",args,$4);
1625            omFree((ADDRESS)args);
1626            omFree((ADDRESS)$4);
1627          }
1628        ;
1629
1630parametercmd:
1631        PARAMETER declare_ip_variable
1632          {
1633            //Print("par:%s, %d\n",$2.Name(),$2.Typ());
1634            //yylineno--;
1635            if (iiParameter(&$2)) YYERROR;
1636          }
1637        | PARAMETER expr
1638          {
1639            //Print("par:%s, %d\n",$2.Name(),$2.Typ());
1640            sleftv tmp_expr;
1641            //yylineno--;
1642            if ((iiDeclCommand(&tmp_expr,&$2,myynest,DEF_CMD,&IDROOT))
1643            || (iiParameter(&tmp_expr)))
1644              YYERROR;
1645          }
1646        ;
1647
1648returncmd:
1649        RETURN '(' exprlist ')'
1650          {
1651            if(iiRETURNEXPR==NULL) YYERROR;
1652            iiRETURNEXPR[myynest].Copy(&$3);
1653            $3.CleanUp();
1654            if (exitBuffer(BT_proc)) YYERROR;
1655          }
1656        | RETURN '(' ')'
1657          {
1658            if ($1==RETURN)
1659            {
1660              if(iiRETURNEXPR==NULL) YYERROR;
1661              iiRETURNEXPR[myynest].Init();
1662              iiRETURNEXPR[myynest].rtyp=NONE;
1663              if (exitBuffer(BT_proc)) YYERROR;
1664            }
1665          }
1666        ;
Note: See TracBrowser for help on using the repository browser.