source: git/Singular/grammar.y @ 0efdb1

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