home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / x2p / a2p.y < prev    next >
Encoding:
Lex Description  |  1995-09-05  |  9.2 KB  |  398 lines  |  [TEXT/MPS ]
  1. %{
  2. /* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $
  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.  */
  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 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.  
  94. rel    : expr RELOP expr
  95.         { $$ = oper3(ORELOP,$2,$1,$3); }
  96.     | expr '>' expr
  97.         { $$ = oper3(ORELOP,string(">",1),$1,$3); }
  98.     | expr '<' expr
  99.         { $$ = oper3(ORELOP,string("<",1),$1,$3); }
  100.     | '(' rel ')'
  101.         { $$ = oper1(ORPAREN,$2); }
  102.     ;
  103.  
  104. cond    : expr
  105.     | match
  106.     | rel
  107.     | compound_cond
  108.     | cond '?' expr ':' expr
  109.         { $$ = oper3(OCOND,$1,$3,$5); }
  110.     ;
  111.  
  112. compound_cond
  113.     : '(' compound_cond ')'
  114.         { $$ = oper1(OCPAREN,$2); }
  115.     | cond ANDAND maybe cond
  116.         { $$ = oper3(OCANDAND,$1,$3,$4); }
  117.     | cond OROR maybe cond
  118.         { $$ = oper3(OCOROR,$1,$3,$4); }
  119.     | NOT cond
  120.         { $$ = oper1(OCNOT,$2); }
  121.     ;
  122.  
  123. match    : expr MATCHOP expr
  124.         { $$ = oper3(OMATCHOP,$2,$1,$3); }
  125.     | expr MATCHOP REGEX
  126.         { $$ = oper3(OMATCHOP,$2,$1,oper1(OREGEX,$3)); }
  127.     | REGEX        %prec MATCHOP
  128.         { $$ = oper1(OREGEX,$1); }
  129.     | '(' match ')'
  130.         { $$ = oper1(OMPAREN,$2); }
  131.     ;
  132.  
  133. term    : variable
  134.         { $$ = $1; }
  135.     | NUMBER
  136.         { $$ = oper1(ONUM,$1); }
  137.     | STRING
  138.         { $$ = oper1(OSTR,$1); }
  139.     | term '+' term
  140.         { $$ = oper2(OADD,$1,$3); }
  141.     | term '-' term
  142.         { $$ = oper2(OSUBTRACT,$1,$3); }
  143.     | term '*' term
  144.         { $$ = oper2(OMULT,$1,$3); }
  145.     | term '/' term
  146.         { $$ = oper2(ODIV,$1,$3); }
  147.     | term '%' term
  148.         { $$ = oper2(OMOD,$1,$3); }
  149.     | term '^' term
  150.         { $$ = oper2(OPOW,$1,$3); }
  151.     | term IN VAR
  152.         { $$ = oper2(ODEFINED,aryrefarg($3),$1); }
  153.     | cond '?' expr ':' expr
  154.         { $$ = oper3(OCOND,$1,$3,$5); }
  155.     | variable INCR
  156.         { $$ = oper1(OPOSTINCR,$1); }
  157.     | variable DECR
  158.         { $$ = oper1(OPOSTDECR,$1); }
  159.     | INCR variable
  160.         { $$ = oper1(OPREINCR,$2); }
  161.     | DECR variable
  162.         { $$ = oper1(OPREDECR,$2); }
  163.     | '-' term %prec UMINUS
  164.         { $$ = oper1(OUMINUS,$2); }
  165.     | '+' term %prec UMINUS
  166.         { $$ = oper1(OUPLUS,$2); }
  167.     | '(' cond ')'
  168.         { $$ = oper1(OPAREN,$2); }
  169.     | GETLINE
  170.         { $$ = oper0(OGETLINE); }
  171.     | GETLINE variable
  172.         { $$ = oper1(OGETLINE,$2); }
  173.     | GETLINE '<' expr
  174.         { $$ = oper3(OGETLINE,Nullop,string("<",1),$3);
  175.             if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  176.     | GETLINE variable '<' expr
  177.         { $$ = oper3(OGETLINE,$2,string("<",1),$4);
  178.             if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  179.     | term 'p' GETLINE
  180.         { $$ = oper3(OGETLINE,Nullop,string("|",1),$1);
  181.             if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  182.     | term 'p' GETLINE variable
  183.         { $$ = oper3(OGETLINE,$4,string("|",1),$1);
  184.             if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  185.     | FUN1
  186.         { $$ = oper0($1); need_entire = do_chop = TRUE; }
  187.     | FUN1 '(' ')'
  188.         { $$ = oper1($1,Nullop); need_entire = do_chop = TRUE; }
  189.     | FUN1 '(' expr ')'
  190.         { $$ = oper1($1,$3); }
  191.     | FUNN '(' expr_list ')'
  192.         { $$ = oper1($1,$3); }
  193.     | USERFUN '(' expr_list ')'
  194.         { $$ = oper2(OUSERFUN,$1,$3); }
  195.     | SPRINTF expr_list
  196.         { $$ = oper1(OSPRINTF,$2); }
  197.     | SUBSTR '(' expr ',' expr ',' expr ')'
  198.         { $$ = oper3(OSUBSTR,$3,$5,$7); }
  199.     | SUBSTR '(' expr ',' expr ')'
  200.         { $$ = oper2(OSUBSTR,$3,$5); }
  201.     | SPLIT '(' expr ',' VAR ',' expr ')'
  202.         { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); }
  203.     | SPLIT '(' expr ',' VAR ',' REGEX ')'
  204.         { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));}
  205.     | SPLIT '(' expr ',' VAR ')'
  206.         { $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); }
  207.     | INDEX '(' expr ',' expr ')'
  208.         { $$ = oper2(OINDEX,$3,$5); }
  209.     | MATCH '(' expr ',' REGEX ')'
  210.         { $$ = oper2(OMATCH,$3,oper1(OREGEX,$5)); }
  211.     | MATCH '(' expr ',' expr ')'
  212.         { $$ = oper2(OMATCH,$3,$5); }
  213.     | SUB '(' expr ',' expr ')'
  214.         { $$ = oper2(OSUB,$3,$5); }
  215.     | SUB '(' REGEX ',' expr ')'
  216.         { $$ = oper2(OSUB,oper1(OREGEX,$3),$5); }
  217.     | GSUB '(' expr ',' expr ')'
  218.         { $$ = oper2(OGSUB,$3,$5); }
  219.     | GSUB '(' REGEX ',' expr ')'
  220.         { $$ = oper2(OGSUB,oper1(OREGEX,$3),$5); }
  221.     | SUB '(' expr ',' expr ',' expr ')'
  222.         { $$ = oper3(OSUB,$3,$5,$7); }
  223.     | SUB '(' REGEX ',' expr ',' expr ')'
  224.         { $$ = oper3(OSUB,oper1(OREGEX,$3),$5,$7); }
  225.     | GSUB '(' expr ',' expr ',' expr ')'
  226.         { $$ = oper3(OGSUB,$3,$5,$7); }
  227.     | GSUB '(' REGEX ',' expr ',' expr ')'
  228.         { $$ = oper3(OGSUB,oper1(OREGEX,$3),$5,$7); }
  229.     ;
  230.  
  231. expr    : expr term
  232.         { $$ = oper2(OCONCAT,$1,$2); }
  233.     | term
  234.         { $$ = $1; }
  235.     | variable ASGNOP cond
  236.         { $$ = oper3(OASSIGN,$2,$1,$3);
  237.             if ((ops[$1].ival & 255) == OFLD)
  238.                 lval_field = TRUE;
  239.             if ((ops[$1].ival & 255) == OVFLD)
  240.                 lval_field = TRUE;
  241.         }
  242.     ;
  243.  
  244. variable: VAR
  245.         { $$ = oper1(OVAR,$1); }
  246.     | VAR '[' expr_list ']'
  247.         { $$ = oper2(OVAR,aryrefarg($1),$3); }
  248.     | FIELD
  249.         { $$ = oper1(OFLD,$1); }
  250.     | VFIELD term
  251.         { $$ = oper1(OVFLD,$2); }
  252.     ;
  253.  
  254. expr_list
  255.     : expr
  256.     | clist
  257.     | /* NULL */
  258.         { $$ = Nullop; }
  259.     ;
  260.  
  261. clist    : expr ',' maybe expr
  262.         { $$ = oper3(OCOMMA,$1,$3,$4); }
  263.     | clist ',' maybe expr
  264.         { $$ = oper3(OCOMMA,$1,$3,$4); }
  265.     | '(' clist ')'        /* these parens are invisible */
  266.         { $$ = $2; }
  267.     ;
  268.  
  269. junk    : junk hunksep
  270.         { $$ = oper2(OJUNK,$1,$2); }
  271.     | /* NULL */
  272.         { $$ = Nullop; }
  273.     ;
  274.  
  275. hunksep : ';'
  276.         { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
  277.     | SEMINEW
  278.         { $$ = oper2(OJUNK,oper0(OSEMICOLON),oper0(ONEWLINE)); }
  279.     | NEWLINE
  280.         { $$ = oper0(ONEWLINE); }
  281.     | COMMENT
  282.         { $$ = oper1(OCOMMENT,$1); }
  283.     ;
  284.  
  285. maybe    : maybe nlstuff
  286.         { $$ = oper2(OJUNK,$1,$2); }
  287.     | /* NULL */
  288.         { $$ = Nullop; }
  289.     ;
  290.  
  291. nlstuff : NEWLINE
  292.         { $$ = oper0(ONEWLINE); }
  293.     | COMMENT
  294.         { $$ = oper1(OCOMMENT,$1); }
  295.     ;
  296.  
  297. separator
  298.     : ';' maybe
  299.         { $$ = oper2(OJUNK,oper0(OSEMICOLON),$2); }
  300.     | SEMINEW maybe
  301.         { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
  302.     | NEWLINE maybe
  303.         { $$ = oper2(OJUNK,oper0(OSNEWLINE),$2); }
  304.     | COMMENT maybe
  305.         { $$ = oper2(OJUNK,oper1(OSCOMMENT,$1),$2); }
  306.     ;
  307.  
  308. states    : states statement
  309.         { $$ = oper2(OSTATES,$1,$2); }
  310.     | /* NULL */
  311.         { $$ = Nullop; }
  312.     ;
  313.  
  314. statement
  315.     : simple separator maybe
  316.         { $$ = oper2(OJUNK,oper2(OSTATE,$1,$2),$3); }
  317.     | ';' maybe
  318.         { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSEMICOLON),$2)); }
  319.     | SEMINEW maybe
  320.         { $$ = oper2(OSTATE,Nullop,oper2(OJUNK,oper0(OSNEWLINE),$2)); }
  321.     | compound
  322.     ;
  323.  
  324. simpnull: simple
  325.     | /* NULL */
  326.         { $$ = Nullop; }
  327.     ;
  328.  
  329. simple
  330.     : expr
  331.     | PRINT expr_list redir expr
  332.         { $$ = oper3(OPRINT,$2,$3,$4);
  333.             do_opens = TRUE;
  334.             saw_ORS = saw_OFS = TRUE;
  335.             if (!$2) need_entire = TRUE;
  336.             if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  337.     | PRINT expr_list
  338.         { $$ = oper1(OPRINT,$2);
  339.             if (!$2) need_entire = TRUE;
  340.             saw_ORS = saw_OFS = TRUE;
  341.         }
  342.     | PRINTF expr_list redir expr
  343.         { $$ = oper3(OPRINTF,$2,$3,$4);
  344.             do_opens = TRUE;
  345.             if (!$2) need_entire = TRUE;
  346.             if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; }
  347.     | PRINTF expr_list
  348.         { $$ = oper1(OPRINTF,$2);
  349.             if (!$2) need_entire = TRUE;
  350.         }
  351.     | BREAK
  352.         { $$ = oper0(OBREAK); }
  353.     | NEXT
  354.         { $$ = oper0(ONEXT); }
  355.     | EXIT
  356.         { $$ = oper0(OEXIT); }
  357.     | EXIT expr
  358.         { $$ = oper1(OEXIT,$2); }
  359.     | CONTINUE
  360.         { $$ = oper0(OCONTINUE); }
  361.     | RET
  362.         { $$ = oper0(ORETURN); }
  363.     | RET expr
  364.         { $$ = oper1(ORETURN,$2); }
  365.     | DELETE VAR '[' expr_list ']'
  366.         { $$ = oper2(ODELETE,aryrefarg($2),$4); }
  367.     ;
  368.  
  369. redir    : '>'    %prec FIELD
  370.         { $$ = oper1(OREDIR,string(">",1)); }
  371.     | GRGR
  372.         { $$ = oper1(OREDIR,string(">>",2)); }
  373.     | '|'
  374.         { $$ = oper1(OREDIR,string("|",1)); }
  375.     ;
  376.  
  377. compound
  378.     : IF '(' cond ')' maybe statement
  379.         { $$ = oper2(OIF,$3,bl($6,$5)); }
  380.     | IF '(' cond ')' maybe statement ELSE maybe statement
  381.         { $$ = oper3(OIF,$3,bl($6,$5),bl($9,$8)); }
  382.     | WHILE '(' cond ')' maybe statement
  383.         { $$ = oper2(OWHILE,$3,bl($6,$5)); }
  384.     | DO maybe statement WHILE '(' cond ')'
  385.         { $$ = oper2(ODO,bl($3,$2),$6); }
  386.     | FOR '(' simpnull ';' cond ';' simpnull ')' maybe statement
  387.         { $$ = oper4(OFOR,$3,$5,$7,bl($10,$9)); }
  388.     | FOR '(' simpnull ';'  ';' simpnull ')' maybe statement
  389.         { $$ = oper4(OFOR,$3,string("",0),$6,bl($9,$8)); }
  390.     | FOR '(' expr ')' maybe statement
  391.         { $$ = oper2(OFORIN,$3,bl($6,$5)); }
  392.     | '{' maybe states '}' maybe
  393.         { $$ = oper3(OBLOCK,oper2(OJUNK,$2,$3),Nullop,$5); }
  394.     ;
  395.  
  396. %%
  397. #include "a2py.c"
  398.