BSD 4_3 release

[unix-history] / usr / src / usr.bin / f77 / src / f77pass1 / gram.expr

/*
* Copyright (c) 1980 Regents of the University of California.
* All rights reserved.  The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
*
*      @(#)gram.expr   5.2 (Berkeley) 1/7/86
*/

/*
* gram.expr
*
* Grammar for expressions, f77 compiler pass 1, 4.2 BSD.
*
* University of Utah CS Dept modification history:
*
* $Log:        gram.expr,v $
* Revision 5.2  85/12/21  07:26:39  donn
* Permit CHARACTER*(4) in function declarations by eliminating parentheses
* more appropriately.
* 
* Revision 5.1  85/08/10  03:47:25  donn
* 4.3 alpha
* 
* Revision 3.2  85/02/15  19:08:53  donn
* Put OPPAREN operators in trees when not optimizing as well as when
* optimizing -- this allows '(1)' to produce a writable temporary instead
* of a read-only constant when passed as an argument to a subroutine.
* 
* Revision 3.1  84/10/13  00:42:08  donn
* Installed Jerry Berkman's version with cosmetic changes.
* 
* Revision 1.2  84/08/04  21:27:05  donn
* Added Jerry Berkman's fix to stop complaints about parentheses in
* declarations.
* 
*/

funarglist:
               { $$ = 0; }
       | funargs
       ;

funargs:  expr
               { $$ = mkchain($1, CHNULL); }
       | funargs SCOMMA expr
               { $$ = hookup($1, mkchain($3,CHNULL) ); }
       ;


expr:     uexpr
       | SLPAR expr SRPAR
               { if (parstate > INDCL)
                       $$ = mkexpr(OPPAREN, $2, ENULL);
                 else $$ = $2;
               }
       | complex_const
       ;

uexpr:    lhs
       | simple_const
       | expr addop expr   %prec SPLUS
               { $$ = mkexpr($2, $1, $3); }
       | expr SSTAR expr
               { $$ = mkexpr(OPSTAR, $1, $3); }
       | expr SSLASH expr
               { $$ = mkexpr(OPSLASH, $1, $3); }
       | expr SPOWER expr
               { $$ = mkexpr(OPPOWER, $1, $3); }
       | addop expr  %prec SSTAR
               { if($1 == OPMINUS)
                       $$ = mkexpr(OPNEG, $2, ENULL);
                 else  $$ = $2;
               }
       | expr relop expr  %prec SEQ
               { $$ = mkexpr($2, $1, $3); }
       | expr SEQV expr
               { NO66(".EQV. operator");
                 $$ = mkexpr(OPEQV, $1,$3); }
       | expr SNEQV expr
               { NO66(".NEQV. operator");
                 $$ = mkexpr(OPNEQV, $1, $3); }
       | expr SOR expr
               { $$ = mkexpr(OPOR, $1, $3); }
       | expr SAND expr
               { $$ = mkexpr(OPAND, $1, $3); }
       | SNOT expr
               { $$ = mkexpr(OPNOT, $2, ENULL); }
       | expr SCONCAT expr
               { NO66("concatenation operator //");
                 $$ = mkexpr(OPCONCAT, $1, $3); }
       ;

addop:    SPLUS         { $$ = OPPLUS; }
       | SMINUS        { $$ = OPMINUS; }
       ;

relop:    SEQ   { $$ = OPEQ; }
       | SGT   { $$ = OPGT; }
       | SLT   { $$ = OPLT; }
       | SGE   { $$ = OPGE; }
       | SLE   { $$ = OPLE; }
       | SNE   { $$ = OPNE; }
       ;

lhs:     name
               { $$ = mkprim($1, PNULL, CHNULL); }
       | name substring
               { NO66("substring operator :");
                 if( $1->vclass != CLPARAM ) {
                       $$ = mkprim($1, PNULL, $2);
                 } else {
                       errstr("substring of parameter %s",
                               varstr(VL,$1->varname) );
                       YYERROR ;
                 }
               }
       | name SLPAR funarglist SRPAR
               { if( $1->vclass != CLPARAM ) {
                       $$ = mkprim($1, mklist($3), CHNULL);
                 } else {
                       errstr("can not subscript parameter %s",
                               varstr(VL,$1->varname) );
                       YYERROR ;
                 }
               }
       | name SLPAR funarglist SRPAR substring
               { if( $1->vclass != CLPARAM ) {
                       NO66("substring operator :");
                       $$ = mkprim($1, mklist($3), $5);
                 } else {
                       errstr("can not subscript parameter %s",
                               varstr(VL,$1->varname) );
                       YYERROR ;
                 }
               }
       ;

substring:  SLPAR opt_expr SCOLON opt_expr SRPAR
               { $$ = mkchain($2, mkchain($4,CHNULL)); }
       ;

opt_expr:
               { $$ = 0; }
       | expr
       ;


simple_const:   STRUE   { $$ = mklogcon(1); }
       | SFALSE        { $$ = mklogcon(0); }
       | SHOLLERITH  { $$ = mkstrcon(toklen, token); }
       | SICON = { $$ = mkintcon( convci(toklen, token) ); }
       | SRCON = { $$ = mkrealcon(TYREAL, convcd(toklen, token)); }
       | SDCON = { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); }
       ;

complex_const:  SLPAR uexpr SCOMMA uexpr SRPAR
               { $$ = mkcxcon($2,$4); }
       ;


fexpr:    unpar_fexpr
       | SLPAR fexpr SRPAR
               { if (optimflag && parstate > INDCL)
                       $$ = mkexpr(OPPAREN, $2, ENULL);
                 else $$ = $2;
               }
       ;

unpar_fexpr:      lhs
       | simple_const
       | fexpr addop fexpr   %prec SPLUS
               { $$ = mkexpr($2, $1, $3); }
       | fexpr SSTAR fexpr
               { $$ = mkexpr(OPSTAR, $1, $3); }
       | fexpr SSLASH fexpr
               { $$ = mkexpr(OPSLASH, $1, $3); }
       | fexpr SPOWER fexpr
               { $$ = mkexpr(OPPOWER, $1, $3); }
       | addop fexpr  %prec SSTAR
               { if($1 == OPMINUS)
                       $$ = mkexpr(OPNEG, $2, ENULL);
                 else  $$ = $2;
               }
       | fexpr SCONCAT fexpr
               { NO66("concatenation operator //");
                 $$ = mkexpr(OPCONCAT, $1, $3); }
       ;