=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/parse/parse.y,v retrieving revision 1.1.1.1 retrieving revision 1.35 diff -u -p -r1.1.1.1 -r1.35 --- OpenXM_contrib2/asir2000/parse/parse.y 1999/12/03 07:39:12 1.1.1.1 +++ OpenXM_contrib2/asir2000/parse/parse.y 2012/12/17 07:20:45 1.35 @@ -1,36 +1,80 @@ -/* $OpenXM: OpenXM/src/asir99/parse/parse.y,v 1.2 1999/11/18 05:42:03 noro Exp $ */ +/* + * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED + * All rights reserved. + * + * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited, + * non-exclusive and royalty-free license to use, copy, modify and + * redistribute, solely for non-commercial and non-profit purposes, the + * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and + * conditions of this Agreement. For the avoidance of doubt, you acquire + * only a limited right to use the SOFTWARE hereunder, and FLL or any + * third party developer retains all rights, including but not limited to + * copyrights, in and to the SOFTWARE. + * + * (1) FLL does not grant you a license in any way for commercial + * purposes. You may use the SOFTWARE only for non-commercial and + * non-profit purposes only, such as academic, research and internal + * business use. + * (2) The SOFTWARE is protected by the Copyright Law of Japan and + * international copyright treaties. If you make copies of the SOFTWARE, + * with or without modification, as permitted hereunder, you shall affix + * to all such copies of the SOFTWARE the above copyright notice. + * (3) An explicit reference to this SOFTWARE and its copyright owner + * shall be made on your publication or presentation in any form of the + * results obtained by use of the SOFTWARE. + * (4) In the event that you modify the SOFTWARE, you shall notify FLL by + * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification + * for such modification or the source code of the modified part of the + * SOFTWARE. + * + * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL + * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND + * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS + * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES' + * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY + * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY. + * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT, + * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY + * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL + * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES + * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES + * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY + * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF + * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART + * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY + * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, + * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. + * + * $OpenXM: OpenXM_contrib2/asir2000/parse/parse.y,v 1.34 2011/06/16 08:17:15 noro Exp $ +*/ %{ -#define malloc(x) GC_malloc(x) -#define realloc(x,y) GC_realloc(x,y) -#define free(x) GC_free(x) +#define malloc(x) Risa_GC_malloc(x) +#define realloc(x,y) Risa_GC_realloc(x,y) +#define free(x) Risa_GC_free(x) -#if defined(THINK_C) -#define alloca(x) GC_malloc(x) -#endif #if defined(TOWNS) #include #endif #include #include "ca.h" -#if !defined(THINK_C) #include #include -#endif #include "parse.h" #define NOPR (prresult=0) -extern int gdef; +extern int gdef,mgdef,ldef; extern SNODE parse_snode; -extern int main_parser; +extern int main_parser, allow_create_var; -int prresult; +int prresult,saveresult; static int ind; static FNODE t; static NODE a,b; static NODE2 a2; static pointer val; +static QUOTE quote; extern jmp_buf env; %} @@ -45,8 +89,9 @@ extern jmp_buf env; pointer p; } -%token STRUCT POINT NEWSTRUCT ANS FDEF PFDEF GLOBAL CMP OR AND CAR CDR -%token DO WHILE FOR IF ELSE BREAK RETURN CONTINUE PARIF MAP TIMER GF2NGEN GFPNGEN GETOPT +%token STRUCT POINT NEWSTRUCT ANS FDEF PFDEF MODDEF MODEND +%token GLOBAL MGLOBAL LOCAL LOCALF CMP OR AND CAR CDR QUOTED COLONCOLON +%token DO WHILE FOR IF ELSE BREAK RETURN CONTINUE PARIF MAP RECMAP TIMER GF2NGEN GFPNGEN GFSNGEN GETOPT %token FOP_AND FOP_OR FOP_IMPL FOP_REPL FOP_EQUIV FOP_NOT LOP %token

FORMULA UCASE LCASE STR SELF BOPASS %token

'+' '-' '*' '/' '^' '%' @@ -54,10 +99,11 @@ extern jmp_buf env; %type

desc rawstr %type expr pexpr opt %type stat complex -%type stats node _node pvars fields members optlist +%type stats node _node pvars vars members optlist %right '=' BOPASS %right '?' ':' +%left '`' %right FOP_NOT %left FOP_EQUIV %left FOP_REPL @@ -82,18 +128,26 @@ extern jmp_buf env; %% start : stat - { parse_snode = $1; YYACCEPT; } + { + parse_snode = $1; + if ( yychar >= 0 ) + fprintf(stderr, + "Warning: a token was wasted after an 'if' statement without 'else'.\n"); + YYACCEPT; + } ; stat : tail { $$ = 0; } | GLOBAL { gdef=1; } pvars { gdef=0; } tail - { $$ = 0; } - | STRUCT rawstr '{' fields '}' tail - { structdef($2,$4); $$ = 0; } - | STRUCT rawstr '{' fields '}' pvars tail - { structdef($2,$4); setstruct($2,$6); $$ = 0; } - | STRUCT rawstr pvars tail - { setstruct($2,$3); $$ = 0; } + { $$ = 0; NOPR; } + | MGLOBAL { mgdef=1; } pvars { mgdef=0; } tail + { $$ = 0; NOPR; } + | LOCAL { ldef=1; } pvars { ldef=0; } tail + { $$ = 0; NOPR; } + | LOCALF vars tail + { appenduflist($2); $$ = 0; NOPR; } + | STRUCT rawstr '{' members '}' tail + { structdef($2,$4); $$ = 0; NOPR; } | expr tail { $$ = mksnode(1,S_SINGLE,$1); } | complex @@ -103,29 +157,37 @@ stat : tail | CONTINUE tail { $$ = mksnode(0,S_CONTINUE); } | RETURN tail - { $$ = mksnode(1,S_RETURN,0); } + { $$ = mksnode(1,S_RETURN,NULLP); } | RETURN expr tail { $$ = mksnode(1,S_RETURN,$2); } | IF '(' node ')' stat - { $$ = mksnode(4,S_IFELSE,$1,$3,$5,0); $5?$$->ln=$5->ln:0; NOPR; } + { $$ = mksnode(4,S_IFELSE,$1,$3,$5,NULLP); $5?$$->ln=$5->ln:0; NOPR; } | IF '(' node ')' stat ELSE stat { $$ = mksnode(4,S_IFELSE,$1,$3,$5,$7); $7?$$->ln=$7->ln:0; NOPR; } | FOR '(' node ';' node ';' node ')' stat { $$ = mksnode(5,S_FOR,$1,$3,$5?$5:ONENODE,$7,$9); $9?$$->ln=$9->ln:0; NOPR; } | WHILE '(' node ')' stat - { $$ = mksnode(5,S_FOR,$1,0,$3,0,$5); $5?$$->ln=$5->ln:0; NOPR; } + { $$ = mksnode(5,S_FOR,$1,NULLP,$3,NULLP,$5); $5?$$->ln=$5->ln:0; NOPR; } | DO stat WHILE '(' node ')' tail - { $$ = mksnode(3,S_DO,$1,$2,$5); } + { $$ = mksnode(3,S_DO,$1,$2,$5); NOPR; } | LCASE '(' node ')' ':' '=' expr tail { $$ = mksnode(3,S_PFDEF,$1,$3,$7); NOPR; } - | PFDEF LCASE '(' node ')' - { $$ = mksnode(3,S_PFDEF,$2,$4,0); NOPR; } - | FDEF LCASE { mkpvs(); } '(' node ')' desc '{' stats '}' + | PFDEF LCASE '(' node ')' tail + { $$ = mksnode(3,S_PFDEF,$2,$4,NULLP); NOPR; } + | FDEF LCASE { mkpvs($2); } '(' { ldef = 1; } node { ldef = -1; } ')' desc '{' stats '}' { - mkuf($2,asir_infile->name,$5, - mksnode(1,S_CPLX,$9),$1,asir_infile->ln,$7); - $$ = 0; NOPR; + mkuf($2,asir_infile->name,$6, + mksnode(1,S_CPLX,$11),$1,asir_infile->ln,$9,CUR_MODULE); + $$ = 0; NOPR; } + | MODDEF LCASE tail + { + CUR_MODULE = mkmodule($2); + MPVS = CUR_MODULE->pvs; + $$ = mksnode(1,S_MODULE,CUR_MODULE); NOPR; + } + | MODEND tail + { CUR_MODULE = 0; MPVS = 0; $$ = mksnode(1,S_MODULE,NULLP); NOPR; } | error tail { yyerrok; $$ = 0; } ; @@ -133,6 +195,7 @@ tail : ';' { if ( main_parser ) prresult = 1; } | '$' { if ( main_parser ) prresult = 0; } +; desc : { $$ = 0; } | STR @@ -141,18 +204,16 @@ desc : complex : '{' stats '}' { $$ = mksnode(1,S_CPLX,$2); } ; -fields : - { $$ = 0; } - | fields members tail - { MKNODE(a,0,$2); appendtonode($1,(pointer)a,&$$); } - | fields STRUCT rawstr members tail - { MKNODE(a,$3,$4); appendtonode($1,(pointer)a,&$$); } - ; members : rawstr { MKNODE($$,$1,0); } | members ',' rawstr { appendtonode($1,$3,&$$); } ; +vars : LCASE + { MKNODE($$,$1,0); } + | vars ',' LCASE + { appendtonode($1,$3,&$$); } + ; pvars : UCASE { val = (pointer)makepvar($1); MKNODE($$,val,0); } | pvars ',' UCASE @@ -196,25 +257,21 @@ pexpr : STR { $$ = mkfnode(0,I_GF2NGEN); } | GFPNGEN { $$ = mkfnode(0,I_GFPNGEN); } + | GFSNGEN + { $$ = mkfnode(0,I_GFSNGEN); } | LCASE { FUNC f; searchf(noargsysf,$1,&f); if ( f ) - $$ = mkfnode(2,I_FUNC,f,0); + $$ = mkfnode(2,I_FUNC,f,NULLP); else { searchc($1,&f); if ( f ) - $$ = mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,0)); + $$ = mkfnode(2,I_FUNC,f,mkfnode(1,I_LIST,NULLP)); else { - searchf(sysf,$1,&f); - if ( !f ) - searchf(ubinf,$1,&f); - if ( !f ) - searchpf($1,&f); - if ( !f ) - searchf(usrf,$1,&f); + gen_searchf_searchonly($1,(FUNC *)&f); if ( f ) makesrvar(f,(P *)&val); else @@ -225,58 +282,54 @@ pexpr : STR } | LCASE '(' node ')' { - searchf(sysf,$1,(FUNC *)&val); - if ( !val ) - searchf(ubinf,$1,(FUNC *)&val); - if ( !val ) - searchpf($1,(FUNC *)&val); - if ( !val ) - searchf(usrf,$1,(FUNC *)&val); - if ( !val ) - appenduf($1,(FUNC *)&val); + gen_searchf($1,(FUNC *)&val); + print_crossref(val); $$ = mkfnode(2,I_FUNC,val,mkfnode(1,I_LIST,$3)); } | LCASE '(' node '|' optlist ')' { - searchf(sysf,$1,(FUNC *)&val); - if ( !val ) - searchf(ubinf,$1,(FUNC *)&val); - if ( !val ) - searchpf($1,(FUNC *)&val); - if ( !val ) - searchf(usrf,$1,(FUNC *)&val); - if ( !val ) - appenduf($1,(FUNC *)&val); + gen_searchf($1,(FUNC *)&val); + print_crossref(val); $$ = mkfnode(3,I_FUNC_OPT,val, mkfnode(1,I_LIST,$3),mkfnode(1,I_LIST,$5)); } + | MAP '(' LCASE ',' node ')' + { + gen_searchf($3,(FUNC *)&val); + print_crossref(val); + $$ = mkfnode(2,I_MAP,val,mkfnode(1,I_LIST,$5)); + } + | RECMAP '(' LCASE ',' node ')' + { + gen_searchf($3,(FUNC *)&val); + print_crossref(val); + $$ = mkfnode(2,I_RECMAP,val,mkfnode(1,I_LIST,$5)); + } | LCASE '{' node '}' '(' node ')' { searchpf($1,(FUNC *)&val); - $$ = mkfnode(2,I_PFDERIV,val,mkfnode(1,I_LIST,$6),mkfnode(1,I_LIST,$3)); + $$ = mkfnode(3,I_PFDERIV,val,mkfnode(1,I_LIST,$6),mkfnode(1,I_LIST,$3)); } | GETOPT '(' rawstr ')' { $$ = mkfnode(2,I_GETOPT,$3); } - | MAP '(' LCASE ',' node ')' + | GETOPT '(' ')' { - searchf(sysf,$3,(FUNC *)&val); - if ( !val ) - searchf(ubinf,$3,(FUNC *)&val); - if ( !val ) - searchpf($3,(FUNC *)&val); - if ( !val ) - searchf(usrf,$3,(FUNC *)&val); - if ( !val ) - appenduf($3,(FUNC *)&val); - $$ = mkfnode(2,I_MAP,val,mkfnode(1,I_LIST,$5)); + $$ = mkfnode(2,I_GETOPT,NULLP); } | TIMER '(' expr ',' expr ',' expr ')' { $$ = mkfnode(3,I_TIMER,$3,$5,$7); } + | PARIF '(' LCASE ')' + { + searchf(parif,$3,(FUNC *)&val); + if ( !val ) + mkparif($3,(FUNC *)&val); + $$ = mkfnode(2,I_FUNC,val,NULLP); + } | PARIF '(' LCASE ',' node ')' { searchf(parif,$3,(FUNC *)&val); @@ -286,25 +339,44 @@ pexpr : STR } | '(' '*' expr ')' '(' node ')' { - $$ = mkfnode(2,I_IFUNC,$3,mkfnode(1,I_LIST,$6)); + $$ = mkfnode(2,I_IFUNC,$3,mkfnode(1,I_LIST,$6),NULLP); } + | '(' '*' expr ')' '(' node '|' optlist ')' + { + $$ = mkfnode(3,I_IFUNC,$3,mkfnode(1,I_LIST,$6), + mkfnode(1,I_LIST,$8)); + } + | UCASE '(' node ')' + { + if ( main_parser || allow_create_var ) + t = mkfnode(2,I_PVAR,makepvar($1),NULLP); + else { + ind = searchpvar($1); + if ( ind == -1 ) { + fprintf(stderr,"%s : no such variable.\n",$1); + YYABORT; + } else + t = mkfnode(2,I_PVAR,ind,NULLP); + } + $$ = mkfnode(2,I_IFUNC,t,mkfnode(1,I_LIST,$3)); + } | CAR '(' expr ')' { $$ = mkfnode(1,I_CAR,$3); } | CDR '(' expr ')' { $$ = mkfnode(1,I_CDR,$3); } | '(' expr ')' - { $$ = $2; } + { $$ = mkfnode(1,I_PAREN,$2); } | UCASE { - if ( main_parser ) - $$ = mkfnode(2,I_PVAR,makepvar($1),0); + if ( main_parser || allow_create_var ) + $$ = mkfnode(2,I_PVAR,makepvar($1),NULLP); else { ind = searchpvar($1); if ( ind == -1 ) { fprintf(stderr,"%s : no such variable.\n",$1); YYABORT; } else - $$ = mkfnode(2,I_PVAR,ind,0); + $$ = mkfnode(2,I_PVAR,ind,NULLP); } } | pexpr '[' expr ']' @@ -318,12 +390,12 @@ pexpr : STR } } | pexpr POINT rawstr - { memberofstruct($1,$3,&$$); } + { $$ = mkfnode(2,I_POINT,$1,$3); } ; expr : pexpr { $$ = $1; } | '(' STRUCT rawstr ')' pexpr - { $$ = mkfnode(3,I_CAST,structtoindex($3),$5,0); } + { $$ = mkfnode(3,I_CAST,structtoindex($3),$5,NULLP); } | expr '=' expr { $$ = mkfnode(2,I_ASSPVAR,$1,$3); } | expr BOPASS expr @@ -337,7 +409,7 @@ expr : pexpr | '+' expr %prec PLUS { $$ = $2; } | '-' expr %prec MINUS - { $$ = mkfnode(3,I_BOP,$1,0,$2); } + { $$ = mkfnode(1,I_MINUS,$2); } | expr '+' expr { $$ = mkfnode(3,I_BOP,$2,$1,$3); } | expr '-' expr @@ -359,7 +431,7 @@ expr : pexpr | expr AND expr { $$ = mkfnode(2,I_AND,$1,$3); } | FOP_NOT expr - { $$ = mkfnode(3,I_LOP,$1,$2,0); } + { $$ = mkfnode(3,I_LOP,$1,$2,NULLP); } | expr FOP_AND expr { $$ = mkfnode(3,I_LOP,$2,$1,$3); } | expr FOP_OR expr @@ -378,5 +450,11 @@ expr : pexpr { $$ = mkfnode(1,I_EV,$2); } | NEWSTRUCT '(' rawstr ')' { $$ = mkfnode(1,I_NEWCOMP,(int)structtoindex($3)); } + | QUOTED '(' expr ')' + { MKQUOTE(quote,$3); $$ = mkfnode(1,I_FORMULA,(pointer)quote); } + | '[' node '|' expr ']' + { $$ = mkfnode(2,I_CONS,$2,$4); } + | '`' expr + { MKQUOTE(quote,$2); $$ = mkfnode(1,I_FORMULA,(pointer)quote); } ; %%