fortran语法.c

语言的语法,格式严紧,对于处理yacc,lex有帮助!

X   case TY_CHAR: 
X    emit(CCON, $1.c.u.c); break; 
X   default: 
X    yyerror("Unsupported constant type"); 
X    break; 
X   } 
X  } 
X 
X | OP exp CP 
X | exp PLUS exp { emit(PLUS); } 
X | exp MINUS exp { emit(MINUS); } 
X | exp STAR exp { emit(STAR); } 
X | exp DIV exp { emit(DIV); } 
X | exp POW exp { emit(POW); } 
X | exp CAT exp { emit(CAT); } 
X | exp RELOP exp { emit(RELOP, $2); } 
X | NOT exp { emit(NOT); } 
X | exp AND exp { emit(AND); } 
X | exp OR exp { emit(OR); } 
X | exp EQV exp { emit(EQV, $2); } 
X | MINUS exp %prec UMINUS  { emit(UMINUS); } 
X | OP exp CM exp CP /* complex constant, sort of */ 
X | aryref 
X 
Xaryref:  NAME OP { emit(OP); emit(NAME, $1.n.name); } explist CP 
X   { emit(CP); } 
X ; 
X 
Xexplist: exp 
X | explist CM { emit(CM); } exp 
X ; 
X 
X/* assignment statement or arithmetic statement function, they're 
X syntactically the same */ 
X 
Xs:  lhs EQ exp { emit(EQ); } 
X ; 
X 
Xlhs:  NAME { emit(NAME, $1.n.name); } 
X | aryref 
X ; 
X 
Xs:  do CONST NAME EQ { 
X   emit(DO, $2.c.u.l); 
X   emit(NAME, $3.n.name); 
X  } 
X  exp CM { emit(CM); } exp optstep 
X ; 
X 
X/* hack - normally you can parse statement numbers as numeric constants 
X easily enough, except in a case like 
X  DO 10 E5 = 1,1000 
X where 10E5 looks like a real number.  cxt_do tells the lexer only 
X to recognize an integer here. 
X */ 
X 
Xdo:  DO { context = cxt_do; } 
X ; 
X 
Xoptstep: CM { emit(CM); } exp 
X | /* empty */ 
X ; 
X 
Xs:  CONTINUE { emit(CONTINUE); } 
X ; 
X 
X 
Xs:  if exp ifcp s 
X | if exp ifcp CONST CM CONST CM CONST { 
X   emit(ICON, $4.c.u.l); 
X   emit(ICON, $6.c.u.l); 
X   emit(ICON, $8.c.u.l); 
X  } 
X ; 
X 
Xif:  IF OP { emit(IF); } 
X ; 
X 
X /* check ahead for target of IF statement */ 
X /* we have to use the same prescan to tell how to lex the target 
X    statement of the IF.  Arithmetic IFs work OK because three 
X    integers separated by commas don't look like an assignment 
X    statement. */ 
X 
Xifcp:  CP { if(prescan()) 
X    context = cxt_norm; 
X   else 
X    context = cxt_stmt; 
X   emit(CP); 
X  } 
X ; 
X 
X/* regular, assigned, and computed GOTO */ 
X 
Xs:  GOTO CONST { emit(GOTO, $2.c.u.l); } 
X | GOTO NAME { emit(GOTO, 0L); emit(NAME, $2.n.name); } 
X  optstmtlist 
X | GOTO OP { emit(GOTO, 0L); } stmtlist CP { emit(CP); } 
X  optcomma exp 
X ; 
X 
Xoptstmtlist: CM OP stmtlist CP 
X | /* empty */ 
X ; 
X 
Xstmtlist: CONST { emit(ICON, $1.c.u.l); } 
X | stmtlist CM CONST { emit(ICON, $3.c.u.l); } 
X ; 
X 
Xs:  STOP 
X ; 
X 
Xs:  CALL NAME { emit(CALL, $2.n.name); } 
X | CALL NAME { emit(CALL, $2.n.name); } OP cexplist CP 
X ; 
X 
Xcexplist: cexp 
X | cexplist CM { emit(CM); } cexp 
X ; 
X 
Xcexp:  exp 
X | STAR CONST { emit(1, $2.c.u.l); } 
X ; 
X 
Xs:  RETURN { emit(RETURN); } 
X | RETURN { emit(RETURN); } exp 
X ; 
Xs:  END { emit(END); } 
X ; 
X 
X%% 
X 
X/* your standard error routine */ 
Xvoid yyerror(char *s) 
X{ 
X printf("%d: %s\n", lineno, s); 
X} 
SHAR_EOF 
chmod 0644 fparse.y || echo "restore of fparse.y fails" 
fi 
if test -f fmain.c; then echo "File fmain.c exists"; else 
echo "x - extracting fmain.c (Text)" 
sed 's/^X//' << 'SHAR_EOF' > fmain.c && 
X/************************************************************************* 
X*                                                                        * 
X*     Fortran 77 Subset Parser - November 1988                           * 
X*     Copyright 1988 - John R. Levine.  All rights reserved.             * 
X*     Permission is hereby granted to make copies in modified or         * 
X*     unmodified form so long as this copyright notice is preserved      * 
X*     and such copies are not made for direct commercial advantage.      * 
X*                                                                        * 
X*     Any other use such as incorporation in whole or in part in a       * 
X*     product offered for sale requires separate permission.             * 
X*                                                                        * 
X*     John R. Levine                                                     * 
X*     P.O. Box 349                                                       * 
X*     Cambridge MA 02238-0349                                            * 
X*                                                                        * 
X*     Internet/uucp: [e-mail]    MCI Mail:  103-7498              * 
X*                                                                        * 
X*************************************************************************/ 
X 
X/* simple main program that parses a statement at a time and emits Lisp 
X   expressions corresponding to the parsed tokens. 
X */ 
X 
X#include <stdio.h> 
X#include <stdarg.h> 
X#include "ftn.h" 
X#include "fparse.h" 
X 
XFILE *ifile; 
XFILE *ofile = stdout; 
Xextern yydebug; 
X 
Xmain(ac, av) 
Xchar **av; 
X{ 
X if(av[1][0] == '-') { 
X  yydebug++; 
X  av++; 
X  ac--; 
X } 
X 
X ifile = fopen(av[1], "r"); 
X if(!ifile) { 
X  perror(av[1]); 
X  return 1; 
X } 
X if(ac > 2) { 
X  ofile = fopen(av[2], "w"); 
X  if(!ofile) { 
X   perror(av[2]); 
X   return 1; 
X  } 
X } 
X 
X while(lex0()) {  /* prescan a statement */ 
X  yyparse(); /* then parse it */ 
X  lex1();  /* then clean it up */ 
X } 
X return 0; 
X} 
X 
Xchar *relops[] = { 
X "???",  "EQ", "NE", "LT", "LE", "GT", "GE" 
X}; 
X 
X/*VARARGS*/ 
Xvoid 
Xemit(int tok,...) 
X{ 
X va_list vp; 
X int ty; 
X char *s; 
X 
X switch(tok) { 
X case 0:  s = ""; break; 
X case 1:  s = "STMT"; break; 
X case AND: s = "AND"; break; 
X case CALL: s = "CALL"; break; 
X case CAT: s = "CAT"; break; 
X case CCON: s = "CCON"; break; 
X case CM: s = "CM"; break; 
X case COLON: s = "COLON"; break; 
X case COMMON: s = "COMMON"; break; 
X case CONTINUE: s = "CONTINUE"; break; 
X case CP: s = "CP"; break; 
X case DIV: s = "DIV"; break; 
X case DO: s = "DO"; break; 
X case END: s = "END"; break; 
X case EQ: s = "EQ"; break; 
X case EQV: s = "EQV"; break; 
X case FUNCTION: s = "FUNCTION"; break; 
X case GOTO: s = "GOTO"; break; 
X case ICON: s = "ICON"; break; 
X case IF: s = "IF"; break; 
X case MINUS: s = "MINUS"; break; 
X case NAME: s = "NAME"; break; 
X case NOT: s = "NOT"; break; 
X case OP: s = "OP"; break; 
X case OR: s = "OR"; break; 
X case PLUS: s = "PLUS"; break; 
X case POW: s = "POW"; break; 
X case RCON: s = "RCON"; break; 
X case RELOP: s = "RELOP"; break; 
X case RETURN: s = "RETURN"; break; 
X case STAR: s = "STAR"; break; 
X case SUBROUTINE: s = "SUBROUTINE"; break; 
X case TO: s = "TO"; break; 
X case TYPE: s = "TYPE"; break; 
X case UMINUS: s = "UMINUS"; break; 
X default: s = "???"; break; 
X } /* codes */ 
X 
X fprintf(ofile, "(%s", s); 
X 
X va_start(vp, tok); 
X switch(tok) { 
X case FUNCTION: 
X  ty = va_arg(vp, type); 
X  s = va_arg(vp, char*); 
X  fprintf(ofile, " %d %d %s", TYTYPE(ty), TYLEN(ty), s); 
X  break; 
X case CALL: 
X case NAME: 
X case SUBROUTINE: 
X case TO: 
X  s = va_arg(vp, char*); 
X  if(!s || !*s) 
X   s = "Blank"; 
X  fprintf(ofile, " %s", s); 
X  break; 
X case TYPE: 
X  ty = va_arg(vp, type); 
X  fprintf(ofile, " %d %d", TYTYPE(ty), TYLEN(ty)); 
X  break; 
X case ICON: 
X case DO: 
X case GOTO: 
X case 1: /* hack for *NNN statement numbers in call statements */ 
X  fprintf(ofile, " %ld", va_arg(vp, long)); 
X  break; 
X case CCON: 
X  fprintf(ofile, " \"%s\"", va_arg(vp, char *)); 
X  break; 
X case RCON: 
X  fprintf(ofile, " %g", va_arg(vp, double)); 
X  break; 
X case EQV: 
X  fprintf(ofile, " %sEQV", va_arg(vp, int)? "N": ""); 
X  break; 
X case RELOP: 
X  fprintf(ofile, " %s", relops[va_arg(vp, int)]); 
X  break; 
X } 
X fprintf(ofile, ")\n"); 
X va_end(vp); 
X} /* emit */ 
SHAR_EOF 
chmod 0644 fmain.c || echo "restore of fmain.c fails" 
fi 
if test -f ftn.h; then echo "File ftn.h exists"; else 
echo "x - extracting ftn.h (Text)" 
sed 's/^X//' << 'SHAR_EOF' > ftn.h && 
X/************************************************************************* 
X*                                                                        * 
X*     Fortran 77 Subset Parser - November 1988                           * 
X*     Copyright 1988 - John R. Levine.  All rights reserved.             * 
X*     Permission is hereby granted to make copies in modified or         * 
X*     unmodified form so long as this copyright notice is preserved      * 
X*     and such copies are not made for direct commercial advantage.      * 
X*                                                                        * 
X*     Any other use such as incorporation in whole or in part in a       * 
X*     product offered for sale requires separate permission.             * 
X*                                                                        * 
X*     John R. Levine                                                     * 
X*     P.O. Box 349                                                       * 
X*     Cambridge MA 02238-0349                                            * 
X*                                                                        * 
X*     Internet/uucp: [e-mail]    MCI Mail:  103-7498              * 
X*                                                                        * 
X*************************************************************************/ 
X 
X 
X/* some headers for a Fortran parser */ 
X 
Xtypedef unsigned char uchar; 
Xtypedef unsigned short type; /* stores a Fortran type, high byte type, */ 
X    /* low byte length */ 
X 
X/* binary expression */ 
Xtypedef struct _binexp { 
X type t; 
X int expop; 
X union _expr *el; 
X union _expr *er; 
X} binexp; 
X 
X/* Fortran constant */ 
Xtypedef struct _const { 
X type t; 
X union { 
X  long l; 
X  double d; 
X  char *c; 
X } u; 
X} constant; 
X 
X/* name reference */ 
Xtypedef struct _name { 
X type t; 
X char name[32]; 
X} name; 
X 
X/* more or less generic expression */ 
Xtypedef union _expr { 
X struct _binexp b; 
X struct _const c; 
X struct _name n; 
X} expr; 
X 
X/* The Fortran lexical analyzer is very context dependent, here we list the 
X   various contexts that it knows about. 
X */ 
X 
Xenum contexts { 
X cxt_stmt = 0, /* beginning of statement */ 
X cxt_norm, /* normal in an expression */ 
X cxt_do,  /* DO stmt seen */ 
X cxt_type, /* type seen */ 
X} context; 
X 
X/* keyword lookup table */ 
Xtypedef struct _kwdtab { 
X char *kwd; /* text of the keyword */ 
X int ktok; /* token code */ 
X int klex; /* lexical value */ 
X} kwdtab; 
X 
X 
X/* types */ 
X#define TY_NONE  0 /* no type */ 
X#define TY_CHAR  1 
X#define TY_LOGICAL 2 
X#define TY_INTEGER 3 
X#define TY_REAL  4 
X#define TY_COMPLEX 5 
X 
X#define MTYPE(ty, len) ((TY_##ty)<<8|(len)) 
X#define TYTYPE(x) ((x)>>8) /* type part of a type */ 
X#define TYLEN(x) ((x)&0377) /* length part of a type */ 
X 
X/* relops */ 
Xenum relops { 
X rel_eq = 1, 
X rel_ne, 
X rel_lt, 
X rel_le, 
X rel_gt, 
X rel_ge 
X}; 
X 
X/* some random stuff */ 
Xextern int lineno; 
X 
X 
X/* some prototypes */ 

Xvoid yyerror(char *); 
Xvoid emit(int,...); 
SHAR_EOF 
chmod 0644 ftn.h || echo "restore of ftn.h fails" 
fi 
exit 0 
  
-- 
We work in the dark 
We do what we can 
We give what we have 
Our doubt is our passion, and our passion is our task 
The rest is the madness of art.