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