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