source: git/Singular/grammar.y @ a31a46

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