home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perlkt40.zip / A2P.Y < prev    next >
Text File  |  1996-06-13  |  10KB  |  404 lines
  1. %{
  2. /* $RCSfile: a2p.y,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:13:03 $
  3.  *
  4.  *    Copyright (c) 1991, Larry Wall
  5.  *
  6.  *    You may distribute under the terms of either the GNU General Public
  7.  *    License or the Artistic License, as specified in the README file.
  8.  *
  9.  * $Log:    a2p.y,v $
  10.  * Revision 4.0.1.2  92/06/08  16:13:03  lwall
  11.  * patch20: in a2p, getline should allow variable to be array element
  12.  * 
  13.  * Revision 4.0.1.1  91/06/07  12:12:41  lwall
  14.  * patch4: new copyright notice
  15.  * 
  16.  * Revision 4.0  91/03/20  01:57:21  lwall
  17.  * 4.0 baseline.
  18.  * 
  19.  */
  20.  
  21. #include "INTERN.h"
  22. #include "a2p.h"
  23.  
  24. int root;
  25. int begins = Nullop;
  26. int ends = Nullop;
  27.  
  28. %}
  29. %token BEGIN END
  30. %token REGEX
  31. %token SEMINEW NEWLINE COMMENT
  32. %token FUN1 FUNN GRGR
  33. %token PRINT PRINTF SPRINTF SPLIT
  34. %token IF ELSE WHILE FOR IN
  35. %token EXIT NEXT BREAK CONTINUE RET
  36. %token GETLINE DO SUB GSUB MATCH
  37. %token FUNCTION USERFUN DELETE
  38.  
  39. %right ASGNOP
  40. %right '?' ':'
  41. %left OROR
  42. %left ANDAND
  43. %left IN
  44. %left NUMBER VAR SUBSTR INDEX
  45. %left MATCHOP
  46. %left RELOP '<' '>'
  47. %left OR
  48. %left STRING
  49. %left '+' '-'
  50. %left '*' '/' '%'
  51. %right UMINUS
  52. %left NOT
  53. %right '^'
  54. %left INCR DECR
  55. %left FIELD VFIELD
  56.  
  57. %%
  58.  
  59. program    : junk hunks
  60.         { root = oper4(OPROG,$1,begins,$2,ends); }
  61.     ;
  62.  
  63. begin    : BEGIN '{' maybe states '}' junk
  64.         { begins = oper4(OJUNK,begins,$3,$4,$6); in_begin = FALSE;
  65.             $$ = Nullop; }
  66.     ;
  67.  
  68. end    : END '{' maybe states '}'
  69.         { ends = oper3(OJUNK,ends,$3,$4); $$ = Nullop; }
  70.     | end NEWLINE
  71.         { $$ = $1; }
  72.     ;
  73.  
  74. hunks    : hunks hunk junk
  75.         { $$ = oper3(OHUNKS,$1,$2,$3); }
  76.     | /* NULL */
  77.         { $$ = Nullop; }
  78.     ;
  79.  
  80. hunk    : patpat
  81.         { $$ = oper1(OHUNK,$1); need_entire = TRUE; }
  82.     | patpat '{' maybe states '}'
  83.         { $$ = oper2(OHUNK,$1,oper2(OJUNK,$3,$4)); }
  84.     | FUNCTION USERFUN '(' arg_list ')' maybe '{' maybe states '}'
  85.         { fixfargs($2,$4,0); $$ = oper5(OUSERDEF,$2,$4,$6,$8,$9); }
  86.     | '{' maybe states '}'
  87.         { $$ = oper2(OHUNK,Nullop,oper2(OJUNK,$2,$3)); }
  88.     | begin
  89.     | end
  90.     ;
  91.  
  92. arg_list: expr_list
  93.         { $$ = rememberargs($$); }
  94.     ;
  95.  
  96. patpat    : cond
  97.         { $$ = oper1(OPAT,$1); }
  98.     | cond ',' cond
  99.         { $$ = oper2(ORANGE,$1,$3); }
  100.     ;
  101.  
  102. cond    : expr
  103.     | match
  104.     | rel
  105.     | compound_cond
  106.     ;
  107.  
  108. compound_cond
  109.     : '(' compound_cond ')'
  110.         { $$ = oper1(OCPAREN,$2); }
  111.     | cond ANDAND maybe cond
  112.         { $$ = oper3(OCANDAND,$1,$3,$4); }
  113.     | cond OROR maybe cond
  114.         { $$ = oper3(OCOROR,$1,$3,$4); }
  115.     | NOT cond
  116.         { $$ = oper1(OCNOT,$2); }
  117.     ;
  118.  
  119. rel    : expr RELOP expr
  120.         { $$ = oper3(ORELOP,$2,$1,$3); }
  121.     | expr '>' expr
  122.         { $$ = oper3(ORELOP,string(">",1),$1,$3); }
  123.     | expr '<' expr
  124.         { $$ = oper3(ORELOP,string("<",1),$1,$3); }
  125.     | '(' rel ')'
  126.         { $$ = oper1(ORPAREN,$2); }
  127.     ;
  128.  
  129. match    : expr MATCHOP expr
  130.         { $$ = oper3(OMATCHOP,$2,$1,$3); }
  131.     | expr MATCHOP REGEX
  132.         { $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); }
  133.     | REGEX        %prec MATCHOP
  134.         { $$ = oper1(OREGEX,$1); }
  135.     | '(' match ')'
  136.         { $$ = oper1(OMPAREN,$2); }
  137.     ;
  138.  
  139. expr    : term
  140.         { $$ = $1; }
  141.     | expr term
  142.         { $$ = oper2(OCONCAT,$1,$2); }
  143.     | variable ASGNOP cond
  144.         { $$ = oper3(OASSIGN,$2,$1,$3);
  145.             if ((ops[$1].ival & 255) == OFLD)
  146.                 lval_field = TRUE;
  147.             if ((ops[$1].ival & 255) == OVFLD)
  148.                 lval_field = TRUE;
  149.         }
  150.     ;
  151.  
  152. term    : variable
  153.         { $$ = $1; }
  154.     | NUMBER
  155.         { $$ = oper1(ONUM,$1); }
  156.     | STRING
  157.         { $$ = oper1(OSTR,$1); }
  158.     | term '+' term
  159.         { $$ = oper2(OADD,$1,$3); }
  160.     | term '-' term
  161.         { $$ = oper2(OSUBTRACT,$1,$3); }
  162.     | term '*' term
  163.         { $$ = oper2(OMULT,$1,$3); }
  164.     | term '/' term
  165.         { $$ = oper2(ODIV,$1,$3); }
  166.     | term '%' term
  167.         { $$ = oper2(OMOD,$1,$3); }
  168.     | term '^' term
  169.         { $$ = oper2(OPOW,$1,$3); }
  170.     | term IN VAR
  171.         { $$ = oper2(ODEFINED,aryrefarg($3),$1); }
  172.     | term '?' term ':' term
  173.         { $$ = oper3(OCOND,$1,$3,$5); }
  174.     | variable INCR
  175.         { $$ = oper1(OPOSTINCR,$1); }
  176.     | variable DECR
  177.         { $$ = oper1(OPOSTDECR,$1); }
  178.     | INCR variable
  179.         { $$ = oper1(OPREINCR,$2); }
  180.     | DECR variable
  181.         { $$ = oper1(OPREDECR,$2); }
  182.     | '-' term %prec UMINUS
  183.         { $$ = oper1(OUMINUS,$2); }
  184.     | '+' term %prec UMINUS
  185.         { $$ = oper1(OUPLUS,$2); }
  186.     | '(' cond ')'
  187.         { $$ = oper1(OPAREN,$2); }
  188.     | GETLINE
  189.         { $$ = oper0(OGETLINE); }
  190.     | GETLINE variable
  191.         { $$ = oper1(OGETLINE,$2); }
  192.     | GETLINE '<' expr
  193.         { $$ = oper3(OGETLINE,Nullop,string("<",1),$3);
  194.             if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  195.     | GETLINE variable '<' expr
  196.         { $$ = oper3(OGETLINE,$2,string("<",1),$4);
  197.             if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  198.     | term 'p' GETLINE
  199.         { $$ = oper3(OGETLINE,Nullop,string("|",1),$1);
  200.             if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  201.     | term 'p' GETLINE variable
  202.         { $$ = oper3(OGETLINE,$4,string("|",1),$1);
  203.             if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  204.     | FUN1
  205.         { $$ = oper0($1); need_entire = do_chop = TRUE; }
  206.     | FUN1 '(' ')'
  207.         { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; }
  208.     | FUN1 '(' expr ')'
  209.         { $$ = oper1($1,$3); }
  210.     | FUNN '(' expr_list ')'
  211.         { $$ = oper1($1,$3); }
  212.     | USERFUN '(' expr_list ')'
  213.         { $$ = oper2(OUSERFUN,$1,$3); }
  214.     | SPRINTF expr_list
  215.         { $$ = oper1(OSPRINTF,$2); }
  216.     | SUBSTR '(' expr ',' expr ',' expr ')'
  217.         { $$ = oper3(OSUBSTR,$3,$5,$7); }
  218.     | SUBSTR '(' expr ',' expr ')'
  219.         { $$ = oper2(OSUBSTR,$3,$5); }
  220.     | SPLIT '(' expr ',' VAR ',' expr ')'
  221.         { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); }
  222.     | SPLIT '(' expr ',' VAR ',' REGEX ')'
  223.         { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));}
  224.     | SPLIT '(' expr ',' VAR ')'
  225.         { $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); }
  226.     | INDEX '(' expr ',' expr ')'
  227.         { $$ = oper2(OINDEX,$3,$5); }
  228.     | MATCH '(' expr ',' REGEX ')'
  229.         { $$ = oper2(OMATCH,$3,oper1(OREGEX,$5)); }
  230.     | MATCH '(' expr ',' expr ')'
  231.         { $$ = oper2(OMATCH,$3,$5); }
  232.     | SUB '(' expr ',' expr ')'
  233.         { $$ = oper2(OSUB,$3,$5); }
  234.     | SUB '(' REGEX ',' expr ')'
  235.         { $$ = oper2(OSUB,oper1(OREGEX,$3),$5); }
  236.     | GSUB '(' expr ',' expr ')'
  237.         { $$ = oper2(OGSUB,$3,$5); }
  238.     | GSUB '(' REGEX ',' expr ')'
  239.         { $$ = oper2(OGSUB,oper1(OREGEX,$3),$5); }
  240.     | SUB '(' expr ',' expr ',' expr ')'
  241.         { $$ = oper3(OSUB,$3,$5,$7); }
  242.     | SUB '(' REGEX ',' expr ',' expr ')'
  243.         { $$ = oper3(OSUB,oper1(OREGEX,$3),$5,$7); }
  244.     | GSUB '(' expr ',' expr ',' expr ')'
  245.         { $$ = oper3(OGSUB,$3,$5,$7); }
  246.     | GSUB '(' REGEX ',' expr ',' expr ')'
  247.         { $$ = oper3(OGSUB,oper1(OREGEX,$3),$5,$7); }
  248.     ;
  249.  
  250. variable: VAR
  251.         { $$ = oper1(OVAR,$1); }
  252.     | VAR '[' expr_list ']'
  253.         { $$ = oper2(OVAR,aryrefarg($1),$3); }
  254.     | FIELD
  255.         { $$ = oper1(OFLD,$1); }
  256.     | VFIELD term
  257.         { $$ = oper1(OVFLD,$2); }
  258.     ;
  259.  
  260. expr_list
  261.     : expr
  262.     | clist
  263.     | /* NULL */
  264.         { $$ = Nullop; }
  265.     ;
  266.  
  267. clist    : expr ',' maybe expr
  268.         { $$ = oper3(OCOMMA,$1,$3,$4); }
  269.     | clist ',' maybe expr
  270.         { $$ = oper3(OCOMMA,$1,$3,$4); }
  271.     | '(' clist ')'        /* these parens are invisible */
  272.         { $$ = $2; }
  273.     ;
  274.  
  275. junk    : junk hunksep
  276.         { $$ = oper2(OJUNK,$1,$2); }
  277.     | /* NULL */
  278.         { $$ = Nullop; }
  279.     ;
  280.  
  281. hunksep : ';'
  282.         { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
  283.     | SEMINEW
  284.         { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
  285.     | NEWLINE
  286.         { $$ = oper0(ONEWLINE); }
  287.     | COMMENT
  288.         { $$ = oper1(OCOMMENT,$1); }
  289.     ;
  290.  
  291. maybe    : maybe nlstuff
  292.         { $$ = oper2(OJUNK,$1,$2); }
  293.     | /* NULL */
  294.         { $$ = Nullop; }
  295.     ;
  296.  
  297. nlstuff : NEWLINE
  298.         { $$ = oper0(ONEWLINE); }
  299.     | COMMENT
  300.         { $$ = oper1(OCOMMENT,$1); }
  301.     ;
  302.  
  303. separator
  304.     : ';' maybe
  305.         { $$ = oper2(OJUNK,oper0(OSEMICOLON),$2); }
  306.     | SEMINEW maybe
  307.         { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
  308.     | NEWLINE maybe
  309.         { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
  310.     | COMMENT maybe
  311.         { $$ = oper2(OJUNK,oper1(OSCOMMENT,$1),$2); }
  312.     ;
  313.  
  314. states    : states statement
  315.         { $$ = oper2(OSTATES,$1,$2); }
  316.     | /* NULL */
  317.         { $$ = Nullop; }
  318.     ;
  319.  
  320. statement
  321.     : simple separator maybe
  322.         { $$ = oper2(OJUNK,oper2(OSTATE,$1,$2),$3); }
  323.     | ';' maybe
  324.         { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),$2)); }
  325.     | SEMINEW maybe
  326.         { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),$2)); }
  327.     | compound
  328.     ;
  329.  
  330. simpnull: simple
  331.     | /* NULL */
  332.         { $$ = Nullop; }
  333.     ;
  334.  
  335. simple
  336.     : expr
  337.     | PRINT expr_list redir expr
  338.         { $$ = oper3(OPRINT,$2,$3,$4);
  339.             do_opens = TRUE;
  340.             saw_ORS = saw_OFS = TRUE;
  341.             if (!$2) need_entire = TRUE;
  342.             if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  343.     | PRINT expr_list
  344.         { $$ = oper1(OPRINT,$2);
  345.             if (!$2) need_entire = TRUE;
  346.             saw_ORS = saw_OFS = TRUE;
  347.         }
  348.     | PRINTF expr_list redir expr
  349.         { $$ = oper3(OPRINTF,$2,$3,$4);
  350.             do_opens = TRUE;
  351.             if (!$2) need_entire = TRUE;
  352.             if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  353.     | PRINTF expr_list
  354.         { $$ = oper1(OPRINTF,$2);
  355.             if (!$2) need_entire = TRUE;
  356.         }
  357.     | BREAK
  358.         { $$ = oper0(OBREAK); }
  359.     | NEXT
  360.         { $$ = oper0(ONEXT); }
  361.     | EXIT
  362.         { $$ = oper0(OEXIT); }
  363.     | EXIT expr
  364.         { $$ = oper1(OEXIT,$2); }
  365.     | CONTINUE
  366.         { $$ = oper0(OCONTINUE); }
  367.     | RET
  368.         { $$ = oper0(ORETURN); }
  369.     | RET expr
  370.         { $$ = oper1(ORETURN,$2); }
  371.     | DELETE VAR '[' expr ']'
  372.         { $$ = oper2(ODELETE,aryrefarg($2),$4); }
  373.     ;
  374.  
  375. redir    : '>'    %prec FIELD
  376.         { $$ = oper1(OREDIR,string(">",1)); }
  377.     | GRGR
  378.         { $$ = oper1(OREDIR,string(">>",2)); }
  379.     | '|'
  380.         { $$ = oper1(OREDIR,string("|",1)); }
  381.     ;
  382.  
  383. compound
  384.     : IF '(' cond ')' maybe statement
  385.         { $$ = oper2(OIF,$3,bl($6,$5)); }
  386.     | IF '(' cond ')' maybe statement ELSE maybe statement
  387.         { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); }
  388.     | WHILE '(' cond ')' maybe statement
  389.         { $$ = oper2(OWHILE,$3,bl($6,$5)); }
  390.     | DO maybe statement WHILE '(' cond ')'
  391.         { $$ = oper2(ODO,bl($3,$2),$6); }
  392.     | FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement
  393.         { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); }
  394.     | FOR '(' simpnull ';'  ';' simpnull ')' maybe statement
  395.         { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); }
  396.     | FOR '(' expr ')' maybe statement
  397.         { $$ = oper2(OFORIN,$3,bl($6,$5)); }
  398.     | '{' maybe states '}' maybe
  399.         { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); }
  400.     ;
  401.  
  402. %%
  403. #include "a2py.c"
  404.