source: git/Singular/grammar.y @ 400884

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