source: git/Singular/grammar.y @ 210bd9

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