source: git/Singular/grammar.y @ 6004f4

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