diff options
Diffstat (limited to 'perl.y')
| -rw-r--r-- | perl.y | 305 |
1 files changed, 214 insertions, 91 deletions
@@ -1,40 +1,36 @@ -/* $Header: perl.y,v 1.0.1.1 88/01/28 10:25:31 root Exp $ +/* $Header: perl.y,v 2.0 88/06/05 00:09:36 root Exp $ * * $Log: perl.y,v $ - * Revision 1.0.1.1 88/01/28 10:25:31 root - * patch8: added eval operator. - * - * Revision 1.0 87/12/18 15:48:59 root - * Initial revision + * Revision 2.0 88/06/05 00:09:36 root + * Baseline version 2.0. * */ %{ -#include "handy.h" -#include "EXTERN.h" -#include "search.h" -#include "util.h" #include "INTERN.h" #include "perl.h" + char *tokename[] = { "256", "word", "append","open","write","select","close","loopctl", -"using","format","do","shift","push","pop","chop", +"using","format","do","shift","push","pop","chop/study", "while","until","if","unless","else","elsif","continue","split","sprintf", "for", "eof", "tell", "seek", "stat", "function(no args)","function(1 arg)","function(2 args)","function(3 args)","array function", -"join", "sub", +"join", "sub", "file test", "local", "delete", "format lines", "register","array_length", "array", "s","pattern", -"string","y", -"print", "unary operation", +"string","tr", +"list operator", "..", "||", "&&", "==","!=", "EQ", "NE", "<=",">=", "LT", "GT", "LE", "GE", +"unary operation", +"file test", "<<",">>", "=~","!~", "unary -", @@ -42,6 +38,8 @@ char *tokename[] = { "???" }; +STAB *scrstab; + %} %start prog @@ -58,11 +56,11 @@ char *tokename[] = { %token <cval> WORD %token <ival> APPEND OPEN WRITE SELECT CLOSE LOOPEX -%token <ival> USING FORMAT DO SHIFT PUSH POP CHOP +%token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT SPRINTF %token <ival> FOR FEOF TELL SEEK STAT %token <ival> FUNC0 FUNC1 FUNC2 FUNC3 STABFUN -%token <ival> JOIN SUB +%token <ival> JOIN SUB FILETEST LOCAL DELETE %token <formval> FORMLIST %token <stabval> REG ARYLEN ARY %token <arg> SUBST PATTERN @@ -72,14 +70,13 @@ char *tokename[] = { %type <stabval> %type <cmdval> block lineseq line loop cond sideff nexpr else %type <arg> expr sexpr term -%type <arg> condmod loopmod cexpr -%type <arg> texpr print +%type <arg> condmod loopmod +%type <arg> texpr listop %type <cval> label %type <compval> compblock -%nonassoc <ival> PRINT +%nonassoc <ival> LISTOP %left ',' -%nonassoc <ival> UNIOP %right '=' %right '?' ':' %nonassoc DOTDOT @@ -89,6 +86,8 @@ char *tokename[] = { %left '&' %nonassoc EQ NE SEQ SNE %nonassoc '<' '>' LE GE SLT SGT SLE SGE +%nonassoc <ival> UNIOP +%nonassoc FILETEST %left LS RS %left '+' '-' '.' %left '*' '/' '%' 'x' @@ -117,7 +116,8 @@ else : /* NULL */ | ELSE block { $$ = $2; } | ELSIF '(' expr ')' compblock - { $$ = make_ccmd(C_IF,$3,$5); } + { cmdline = $1; + $$ = make_ccmd(C_IF,$3,$5); } ; block : '{' lineseq '}' @@ -137,7 +137,7 @@ line : decl | loop /* loops add their own labels */ | label ';' { if ($1 != Nullch) { - $$ = add_label(make_acmd(C_EXPR, Nullstab, + $$ = add_label($1, make_acmd(C_EXPR, Nullstab, Nullarg, Nullarg) ); } else $$ = Nullcmd; } @@ -156,31 +156,99 @@ sideff : expr ; cond : IF '(' expr ')' compblock - { $$ = make_ccmd(C_IF,$3,$5); } + { cmdline = $1; + $$ = make_ccmd(C_IF,$3,$5); } | UNLESS '(' expr ')' compblock - { $$ = invert(make_ccmd(C_IF,$3,$5)); } + { cmdline = $1; + $$ = invert(make_ccmd(C_IF,$3,$5)); } | IF block compblock - { $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); } + { cmdline = $1; + $$ = make_ccmd(C_IF,cmd_to_arg($2),$3); } | UNLESS block compblock - { $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); } + { cmdline = $1; + $$ = invert(make_ccmd(C_IF,cmd_to_arg($2),$3)); } ; loop : label WHILE '(' texpr ')' compblock - { $$ = wopt(add_label($1, + { cmdline = $2; + $$ = wopt(add_label($1, make_ccmd(C_WHILE,$4,$6) )); } | label UNTIL '(' expr ')' compblock - { $$ = wopt(add_label($1, + { cmdline = $2; + $$ = wopt(add_label($1, invert(make_ccmd(C_WHILE,$4,$6)) )); } | label WHILE block compblock - { $$ = wopt(add_label($1, + { cmdline = $2; + $$ = wopt(add_label($1, make_ccmd(C_WHILE, cmd_to_arg($3),$4) )); } | label UNTIL block compblock - { $$ = wopt(add_label($1, + { cmdline = $2; + $$ = wopt(add_label($1, invert(make_ccmd(C_WHILE, cmd_to_arg($3),$4)) )); } + | label FOR REG '(' expr ')' compblock + { cmdline = $2; + /* + * The following gobbledygook catches EXPRs that + * aren't explicit array refs and translates + * foreach VAR (EXPR) { + * into + * @ary = EXPR; + * foreach VAR (@ary) { + * where @ary is a hidden array made by genstab(). + */ + if ($5->arg_type != O_ARRAY) { + scrstab = aadd(genstab()); + $$ = append_line( + make_acmd(C_EXPR, Nullstab, + l(make_op(O_ASSIGN,2, + listish(make_op(O_ARRAY, 1, + stab2arg(A_STAB,scrstab), + Nullarg,Nullarg, 1)), + listish($5), + Nullarg,1)), + Nullarg), + wopt(over($3,add_label($1, + make_ccmd(C_WHILE, + make_op(O_ARRAY, 1, + stab2arg(A_STAB,scrstab), + Nullarg,Nullarg, 1 ), + $7))))); + } + else { + $$ = wopt(over($3,add_label($1, + make_ccmd(C_WHILE,$5,$7) ))); + } + } + | label FOR '(' expr ')' compblock + { cmdline = $2; + if ($4->arg_type != O_ARRAY) { + scrstab = aadd(genstab()); + $$ = append_line( + make_acmd(C_EXPR, Nullstab, + l(make_op(O_ASSIGN,2, + listish(make_op(O_ARRAY, 1, + stab2arg(A_STAB,scrstab), + Nullarg,Nullarg, 1 )), + listish($4), + Nullarg,1)), + Nullarg), + wopt(over(defstab,add_label($1, + make_ccmd(C_WHILE, + make_op(O_ARRAY, 1, + stab2arg(A_STAB,scrstab), + Nullarg,Nullarg, 1 ), + $6))))); + } + else { /* lisp, anyone? */ + $$ = wopt(over(defstab,add_label($1, + make_ccmd(C_WHILE,$4,$6) ))); + } + } | label FOR '(' nexpr ';' texpr ';' nexpr ')' block /* basically fake up an initialize-while lineseq */ { yyval.compval.comp_true = $10; yyval.compval.comp_alt = $8; + cmdline = $2; $$ = append_line($4,wopt(add_label($1, make_ccmd(C_WHILE,$6,yyval.compval) ))); } | label compblock /* a block is a loop that happens once */ @@ -227,14 +295,10 @@ format : FORMAT WORD '=' FORMLIST '.' ; subrout : SUB WORD block - { stabent($2,TRUE)->stab_sub = $3; } - ; - -expr : print - | cexpr + { make_sub($2,$3); } ; -cexpr : sexpr ',' cexpr +expr : sexpr ',' expr { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg,0); } | sexpr ; @@ -355,26 +419,49 @@ term : '-' term %prec UMINUS { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg,0); } | '~' term { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg,0);} + | FILETEST WORD + { opargs[$1] = 0; /* force it special */ + $$ = make_op($1, 1, + stab2arg(A_STAB,stabent($2,TRUE)), + Nullarg, Nullarg,0); + } + | FILETEST sexpr + { opargs[$1] = 1; + $$ = make_op($1, 1, $2, Nullarg, Nullarg,0); } + | FILETEST + { opargs[$1] = ($1 != O_FTTTY); + $$ = make_op($1, 1, + stab2arg(A_STAB, + $1 == O_FTTTY?stabent("stdin",TRUE):defstab), + Nullarg, Nullarg,0); } + | LOCAL '(' expr ')' + { $$ = localize(listish(make_list(hide_ary($3)))); } | '(' expr ')' { $$ = make_list(hide_ary($2)); } | '(' ')' { $$ = make_list(Nullarg); } + | DO sexpr %prec FILETEST + { $$ = make_op(O_DOFILE,1,$2,Nullarg,Nullarg,0); + allstabs = TRUE;} | DO block %prec '(' { $$ = cmd_to_arg($2); } | REG %prec '(' - { $$ = stab_to_arg(A_STAB,$1); } + { $$ = stab2arg(A_STAB,$1); } | REG '[' expr ']' %prec '(' { $$ = make_op(O_ARRAY, 2, - $3, stab_to_arg(A_STAB,aadd($1)), Nullarg,0); } + $3, stab2arg(A_STAB,aadd($1)), Nullarg,0); } | ARY %prec '(' { $$ = make_op(O_ARRAY, 1, - stab_to_arg(A_STAB,$1), + stab2arg(A_STAB,$1), Nullarg, Nullarg, 1); } | REG '{' expr '}' %prec '(' { $$ = make_op(O_HASH, 2, - $3, stab_to_arg(A_STAB,hadd($1)), Nullarg,0); } + $3, stab2arg(A_STAB,hadd($1)), Nullarg,0); } + | DELETE REG '{' expr '}' %prec '(' + { $$ = make_op(O_DELETE, 2, + $4, stab2arg(A_STAB,hadd($2)), Nullarg,0); } | ARYLEN %prec '(' - { $$ = stab_to_arg(A_ARYLEN,$1); } + { $$ = stab2arg(A_ARYLEN,$1); } | RSTRING %prec '(' { $$ = $1; } | PATTERN %prec '(' @@ -386,12 +473,22 @@ term : '-' term %prec UMINUS | DO WORD '(' expr ')' { $$ = make_op(O_SUBR, 2, make_list($4), - stab_to_arg(A_STAB,stabent($2,TRUE)), + stab2arg(A_WORD,stabent($2,TRUE)), Nullarg,1); } | DO WORD '(' ')' { $$ = make_op(O_SUBR, 2, make_list(Nullarg), - stab_to_arg(A_STAB,stabent($2,TRUE)), + stab2arg(A_WORD,stabent($2,TRUE)), + Nullarg,1); } + | DO REG '(' expr ')' + { $$ = make_op(O_SUBR, 2, + make_list($4), + stab2arg(A_STAB,$2), + Nullarg,1); } + | DO REG '(' ')' + { $$ = make_op(O_SUBR, 2, + make_list(Nullarg), + stab2arg(A_STAB,$2), Nullarg,1); } | LOOPEX { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg,0); } @@ -410,113 +507,133 @@ term : '-' term %prec UMINUS Nullarg, Nullarg, Nullarg,0); } | WRITE '(' WORD ')' { $$ = l(make_op(O_WRITE, 1, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_STAB,stabent($3,TRUE)), Nullarg, Nullarg,0)); safefree($3); } | WRITE '(' expr ')' { $$ = make_op(O_WRITE, 1, $3, Nullarg, Nullarg,0); } | SELECT '(' WORD ')' { $$ = l(make_op(O_SELECT, 1, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_STAB,stabent($3,TRUE)), Nullarg, Nullarg,0)); safefree($3); } | SELECT '(' expr ')' { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg,0); } | OPEN WORD %prec '(' { $$ = make_op(O_OPEN, 2, - stab_to_arg(A_STAB,stabent($2,TRUE)), - stab_to_arg(A_STAB,stabent($2,TRUE)), + stab2arg(A_WORD,stabent($2,TRUE)), + stab2arg(A_STAB,stabent($2,TRUE)), Nullarg,0); } | OPEN '(' WORD ')' { $$ = make_op(O_OPEN, 2, - stab_to_arg(A_STAB,stabent($3,TRUE)), - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_WORD,stabent($3,TRUE)), + stab2arg(A_STAB,stabent($3,TRUE)), Nullarg,0); } | OPEN '(' WORD ',' expr ')' { $$ = make_op(O_OPEN, 2, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_WORD,stabent($3,TRUE)), + $5, Nullarg,0); } + | OPEN '(' sexpr ',' expr ')' + { $$ = make_op(O_OPEN, 2, + $3, $5, Nullarg,0); } | CLOSE '(' WORD ')' { $$ = make_op(O_CLOSE, 1, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_WORD,stabent($3,TRUE)), + Nullarg, Nullarg,0); } + | CLOSE '(' expr ')' + { $$ = make_op(O_CLOSE, 1, + $3, Nullarg, Nullarg,0); } | CLOSE WORD %prec '(' { $$ = make_op(O_CLOSE, 1, - stab_to_arg(A_STAB,stabent($2,TRUE)), + stab2arg(A_WORD,stabent($2,TRUE)), Nullarg, Nullarg,0); } | FEOF '(' WORD ')' { $$ = make_op(O_EOF, 1, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_WORD,stabent($3,TRUE)), + Nullarg, Nullarg,0); } + | FEOF '(' expr ')' + { $$ = make_op(O_EOF, 1, + $3, Nullarg, Nullarg,0); } | FEOF '(' ')' - { $$ = make_op(O_EOF, 0, - stab_to_arg(A_STAB,stabent("ARGV",TRUE)), + { $$ = make_op(O_EOF, 1, + stab2arg(A_WORD,Nullstab), Nullarg, Nullarg,0); } | FEOF { $$ = make_op(O_EOF, 0, Nullarg, Nullarg, Nullarg,0); } | TELL '(' WORD ')' { $$ = make_op(O_TELL, 1, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_WORD,stabent($3,TRUE)), + Nullarg, Nullarg,0); } + | TELL '(' expr ')' + { $$ = make_op(O_TELL, 1, + $3, Nullarg, Nullarg,0); } | TELL { $$ = make_op(O_TELL, 0, Nullarg, Nullarg, Nullarg,0); } | SEEK '(' WORD ',' sexpr ',' expr ')' { $$ = make_op(O_SEEK, 3, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_WORD,stabent($3,TRUE)), + $5, $7,1); } + | SEEK '(' sexpr ',' sexpr ',' expr ')' + { $$ = make_op(O_SEEK, 3, + $3, $5, $7,1); } | PUSH '(' WORD ',' expr ')' { $$ = make_op($1, 2, make_list($5), - stab_to_arg(A_STAB,aadd(stabent($3,TRUE))), + stab2arg(A_STAB,aadd(stabent($3,TRUE))), Nullarg,1); } | PUSH '(' ARY ',' expr ')' { $$ = make_op($1, 2, make_list($5), - stab_to_arg(A_STAB,$3), + stab2arg(A_STAB,$3), Nullarg,1); } | POP WORD %prec '(' { $$ = make_op(O_POP, 1, - stab_to_arg(A_STAB,aadd(stabent($2,TRUE))), + stab2arg(A_STAB,aadd(stabent($2,TRUE))), Nullarg, Nullarg,0); } | POP '(' WORD ')' { $$ = make_op(O_POP, 1, - stab_to_arg(A_STAB,aadd(stabent($3,TRUE))), + stab2arg(A_STAB,aadd(stabent($3,TRUE))), Nullarg, Nullarg,0); } | POP ARY %prec '(' { $$ = make_op(O_POP, 1, - stab_to_arg(A_STAB,$2), + stab2arg(A_STAB,$2), Nullarg, Nullarg, 0); } | POP '(' ARY ')' { $$ = make_op(O_POP, 1, - stab_to_arg(A_STAB,$3), + stab2arg(A_STAB,$3), Nullarg, Nullarg, 0); } | SHIFT WORD %prec '(' { $$ = make_op(O_SHIFT, 1, - stab_to_arg(A_STAB,aadd(stabent($2,TRUE))), + stab2arg(A_STAB,aadd(stabent($2,TRUE))), Nullarg, Nullarg,0); } | SHIFT '(' WORD ')' { $$ = make_op(O_SHIFT, 1, - stab_to_arg(A_STAB,aadd(stabent($3,TRUE))), + stab2arg(A_STAB,aadd(stabent($3,TRUE))), Nullarg, Nullarg,0); } | SHIFT ARY %prec '(' { $$ = make_op(O_SHIFT, 1, - stab_to_arg(A_STAB,$2), Nullarg, Nullarg,0); } + stab2arg(A_STAB,$2), Nullarg, Nullarg,0); } | SHIFT '(' ARY ')' { $$ = make_op(O_SHIFT, 1, - stab_to_arg(A_STAB,$3), Nullarg, Nullarg,0); } + stab2arg(A_STAB,$3), Nullarg, Nullarg,0); } | SHIFT %prec '(' { $$ = make_op(O_SHIFT, 1, - stab_to_arg(A_STAB,aadd(stabent("ARGV",TRUE))), + stab2arg(A_STAB,aadd(stabent("ARGV",TRUE))), Nullarg, Nullarg,0); } | SPLIT %prec '(' - { scanpat("/[ \t\n]+/"); + { scanpat("/\\s+/"); $$ = make_split(defstab,yylval.arg); } | SPLIT '(' WORD ')' - { scanpat("/[ \t\n]+/"); + { scanpat("/\\s+/"); $$ = make_split(stabent($3,TRUE),yylval.arg); } | SPLIT '(' WORD ',' PATTERN ')' { $$ = make_split(stabent($3,TRUE),$5); } @@ -528,12 +645,12 @@ term : '-' term %prec UMINUS { $$ = mod_match(O_MATCH, $5, make_split(defstab,$3) ); } | SPLIT '(' sexpr ')' { $$ = mod_match(O_MATCH, - stab_to_arg(A_STAB,defstab), + stab2arg(A_STAB,defstab), make_split(defstab,$3) ); } | JOIN '(' WORD ',' expr ')' { $$ = make_op(O_JOIN, 2, $5, - stab_to_arg(A_STAB,aadd(stabent($3,TRUE))), + stab2arg(A_STAB,aadd(stabent($3,TRUE))), Nullarg,0); } | JOIN '(' sexpr ',' expr ')' { $$ = make_op(O_JOIN, 2, @@ -547,50 +664,56 @@ term : '-' term %prec UMINUS Nullarg,1); } | STAT '(' WORD ')' { $$ = l(make_op(O_STAT, 1, - stab_to_arg(A_STAB,stabent($3,TRUE)), + stab2arg(A_STAB,stabent($3,TRUE)), Nullarg, Nullarg,0)); } | STAT '(' expr ')' { $$ = make_op(O_STAT, 1, $3, Nullarg, Nullarg,0); } - | CHOP - { $$ = l(make_op(O_CHOP, 1, - stab_to_arg(A_STAB,defstab), + | LVALFUN + { $$ = l(make_op($1, 1, + stab2arg(A_STAB,defstab), Nullarg, Nullarg,0)); } - | CHOP '(' expr ')' - { $$ = l(make_op(O_CHOP, 1, $3, Nullarg, Nullarg,0)); } + | LVALFUN '(' expr ')' + { $$ = l(make_op($1, 1, $3, Nullarg, Nullarg,0)); } | FUNC0 { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg,0); } | FUNC1 '(' expr ')' { $$ = make_op($1, 1, $3, Nullarg, Nullarg,0); } | FUNC2 '(' sexpr ',' expr ')' - { $$ = make_op($1, 2, $3, $5, Nullarg, 0); } + { $$ = make_op($1, 2, $3, $5, Nullarg, 0); + if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE) + fbmcompile($$[2].arg_ptr.arg_str); } | FUNC3 '(' sexpr ',' sexpr ',' expr ')' { $$ = make_op($1, 3, $3, $5, $7, 0); } | STABFUN '(' WORD ')' { $$ = make_op($1, 1, - stab_to_arg(A_STAB,hadd(stabent($3,TRUE))), + stab2arg(A_STAB,hadd(stabent($3,TRUE))), Nullarg, Nullarg, 0); } + | listop ; -print : PRINT +listop : LISTOP { $$ = make_op($1,2, - stab_to_arg(A_STAB,defstab), - stab_to_arg(A_STAB,Nullstab), + stab2arg(A_STAB,defstab), + stab2arg(A_WORD,Nullstab), Nullarg,0); } - | PRINT expr + | LISTOP expr { $$ = make_op($1,2,make_list($2), - stab_to_arg(A_STAB,Nullstab), + stab2arg(A_WORD,Nullstab), Nullarg,1); } - | PRINT WORD + | LISTOP WORD { $$ = make_op($1,2, - stab_to_arg(A_STAB,defstab), - stab_to_arg(A_STAB,stabent($2,TRUE)), + stab2arg(A_STAB,defstab), + stab2arg(A_WORD,stabent($2,TRUE)), + Nullarg,1); } + | LISTOP WORD expr + { $$ = make_op($1,2,make_list($3), + stab2arg(A_WORD,stabent($2,TRUE)), Nullarg,1); } - | PRINT WORD expr + | LISTOP REG expr { $$ = make_op($1,2,make_list($3), - stab_to_arg(A_STAB,stabent($2,TRUE)), + stab2arg(A_STAB,$2), Nullarg,1); } ; %% /* PROGRAM */ -#include "perly.c" |