source: git/Singular/grammar.y @ c56606

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