pascal语法.c

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

 Xextern char yytext[]; 
 Xextern char numbertext[80]; 
 Xextern char *laststring; 
 Xextern char lastident[]; 
 X 
 Xextern  char *create_string(); 
 X 
 X#define YYSTYPE item 
 X 
 X 
 Xint lexical_level = 0; 
 X 
 Xstatic int param_level = 0; 
 Xstatic char *its_a = "error - uninitialised"; 
 X 
 X%} 
 X 
 X%start program 
 X 
 X%token UNSIGNED_INT UNSIGNED_REAL STRING IDENTIFIER 
 X%token NE LE GE BECOMES DIV MOD NIL IN OR AND NOT DOTDOT 
 X%token IF THEN ELSE CASE OF REPEAT UNTIL WHILE DO FOR TO DOWNTO 
 X%token SBEGIN END WITH GOTO CONST VAR TYPE ARRAY RECORD SET SFILE FUNCTION 
  
 X%token PROCEDURE LABEL PACKED PROGRAM 
 X 
 X%%   /*start of rules*/ 
 Xprogram  : PROGRAM {its_a="program";} newident external_files ';' 
 X   block '.' 
 X  ; 
 Xexternal_files  : /*empty*/ 
 X  | '(' {its_a="external-file";} newident_list ')' 
 X  ; 
 X 
 Xblock  : opt_declarations  statement_part 
 X  ; 
 Xopt_declarations: /*empty*/ 
 X  | declarations 
 X  ; 
 Xdeclarations : declarations declaration /*should be left-recursive*/ 
 X  | declaration 
 X  ; 
 Xdeclaration : label_dcl_part 
 X  | const_dcl_part 
 X  | type_dcl_part 
 X  | var_dcl_part 
 X  | proc_dcl_part 
 X  ; 
 X 
 Xlabel_dcl_part : LABEL labels ';' 
 X  ; 
 Xlabels  : labels ',' label 
 X  | label 
 X  ; 
 Xlabel  : UNSIGNED_INT  /* 0 <= value <= 9999 [6.1.6] */ 
 X  ; 
 X 
 Xconst_dcl_part : CONST const_defs ';' 
 X  ; 
 Xconst_defs : const_defs ';' const_def 
 X  | const_def 
 X  ; 
 Xconst_def : {its_a="constant";} newident '=' constant 
 X  ; 
 X 
 Xconstant : unsigned_num 
 X  | '+' unsigned_num 
 X  | '-' unsigned_num 
 X  | ident    /*check it is constant*/ 
 X  | '+' ident 
 X  | '-' ident 
 X  | STRING   /*type is char if len=1*/ 
 X  ; 
 X 
 Xunsigned_num : UNSIGNED_INT 
 X  | UNSIGNED_REAL 
 X  ; 
 X 
 Xtype_dcl_part : TYPE type_defs ';' 
 X  ; 
 Xtype_defs : type_defs ';' type_def 
 X  | type_def 
 X  ; 
 Xtype_def : {its_a="type";} newident '=' type 
 X  ; 
 X 
 Xtype  : simple_type 
 X  | PACKED struct_type 
 X  | struct_type 
 X  | '^' IDENTIFIER    /*check forward reference semantics*/ 
 X  ; 
 X 
 Xsimple_type : '(' {its_a="enumerated-literal";} newident_list ')' 
 X  | constant DOTDOT constant 
 X  | ident 
 X  ; 
 X 
 Xstruct_type : ARRAY '[' index_t_list ']' OF type 
 X  | RECORD /*consider this a scope*/ field_list END 
 X  | SET OF simple_type 
 X  | SFILE OF type 
 X  ; 
 Xindex_t_list : index_t_list ',' simple_type 
 X  | simple_type 
 X  ; 
 Xfield_list : fixed_part 
 X  | fixed_part ';' variant_part 
 X  | variant_part 
 X  ; 
 Xfixed_part : fixed_part ';' record_section 
 X  | record_section 
 X  ; 
 Xrecord_section : {its_a="field";} newident_list ':' type 
 X  | /*empty*/ 
 X  ; 
 Xvariant_part : CASE {its_a="field";} tag_field OF variants 
 X  ; 
 Xtag_field : newident ':' ident 
 X  | ident /*type*/ 
 X  ; 
 Xvariants : variants ';' variant 
 X  | variant 
 X  ; 
 Xvariant  : case_label_list ':' '(' field_list ')' 
 X  | /*empty*/ 
 X  ; 
 X 
 Xvar_dcl_part : VAR variable_dcls ';' 
 X  ; 
 Xvariable_dcls : variable_dcls ';' variable_dcl 
 X  | variable_dcl 
 X  ; 
 Xvariable_dcl : {its_a="variable";} newident_list ':' type 
 X  ; 
 Xnewident_list : new_id_list {its_a="don't know";} 
 X  ; 
 Xnew_id_list : new_id_list ',' newident 
 X  | newident 
 X  ; 
 X 
 Xproc_dcl_part : proc_or_func 
 X  ; 
 Xproc_or_func : proc_heading ';' body ';'     /*check if forward or fwd ref 
d*/ 
 X   {lexical_level--; 
 X   } 
 X  | func_heading ';' body ';'  /*also func heading may be -type */ 
 X   {lexical_level--; 
 X   } 
 X  ; 
 Xproc_heading : PROCEDURE 
 X   {if(param_level==0)its_a="procedure";} 
 X    newident {lexical_level++;} 
 X   formal_params 
 X  ; 
 Xfunc_heading : FUNCTION 
 X   {if(param_level==0)its_a="function";} 
 X    newident {lexical_level++;} 
 X   function_form 
 X  ; 
 Xfunction_form : /*empty*/   /*if forward referenced*/ 
 X  | formal_params ':' ident 
 X  ; 
 X 
 Xbody  : block 
 X   /* result determined in block */ 
 X  | IDENTIFIER    /*directive-FORWARD*/ 
 X  ; 
 Xformal_params : /*empty*/ 
 X  | '(' {param_level++;} formal_p_sects ')' {param_level--;} 
 X  ; 
 Xformal_p_sects : formal_p_sects ';' formal_p_sect 
 X  | formal_p_sect 
 X  ; 
 Xformal_p_sect : {its_a="value-parameter";} param_group 
 X  | VAR {its_a="var-parameter";} param_group 
 X  | {its_a="procedure-parameter";} proc_heading 
 X   {lexical_level--;} 
 X  | {its_a="function-parameter";} func_heading  {lexical_level--;} 
 X  ; 
 Xparam_group : newident_list ':' paramtype 
 X  ; 
 Xparamtype : ident 
 X  | ARRAY '[' index_specs ']' OF paramtype 
 X  | PACKED ARRAY '[' index_spec ']' OF ident 
 X  ; 
 Xindex_specs : index_specs ';' index_spec 
 X  | index_spec 
 X  ; 
 Xindex_spec : {its_a="conformant-bound";} newident DOTDOT newident ':' iden 
t 
 X  ; 
 X 
 Xstatement_part : compound_stmt 
 X  ; 
 Xcompound_stmt : SBEGIN statements END 
 X  ; 
 Xstatements : statements ';' statement 
 X  | statement 
 X  ; 
 Xstatement : /*empty*/ 
 X  | label ':' statement 
 X  | compound_stmt 
 X  | assignment 
 X  | procedure_call 
 X  | GOTO label 
 X  | IF expression THEN statement 
 X  | IF expression THEN statement ELSE statement 
 X  | CASE expression OF case_list END 
 X  | WHILE expression DO statement 
 X  | REPEAT statements UNTIL expression 
 X  | FOR ident BECOMES expression direction expression DO statement 
 X  | WITH rec_var_list DO statement 
 X  ; 
 Xdirection : TO 
 X  | DOWNTO 
 X  ; 
 X 
 Xassignment : variable BECOMES expression /* must test for fn_ident */ 
 X /* | ident BECOMES expression */ 
 X  ; 
 X 
 Xprocedure_call : ident actual_params 
 X  ; 
 X 
 Xactual_params :  /*empty*/ 
 X  | '(' actuals_list ')' 
 X  ; 
 Xactuals_list : actuals_list ',' actual_param 
 X  | actual_param 
 X  ; 
 Xactual_param : expression    /* which could be a variable or a proc/fn id 
*/ 
 X  | expression colon_things  /* only in i/o */ 
 X  ; 
 Xcolon_things    : ":" expression /*integer*/ 
 X  | ":" expression ":" expression 
 X  ; 
 X 
 Xcase_list : case_list ';' case_list_elem 
 X  | case_list_elem 
 X  ; 
 Xcase_list_elem : case_label_list ':' statement 
 X  | /*empty*/ 
 X  ; 
 Xcase_label_list : case_label_list ',' case_label 
 X  | case_label 
 X  ; 
 Xcase_label : constant 
 X  ; 
 X 
 Xrec_var_list : rec_var_list ',' record_var 
 X  | record_var 
 X  ; 
 X 
 Xexpression : simple_expr 
 X  | simple_expr relational_op simple_expr 
 X  ; 
 Xrelational_op : '=' 
 X  | '<' 
 X  | '>' 
 X  | LE 
 X  | GE 
 X  | NE 
 X  | IN 
 X  ; 
 X 
 Xsimple_expr : term 
 X  | '+' term 
 X  | '-' term 
 X  | simple_expr add_op term 
 X  ; 
 Xadd_op  : '+' 
 X  | '-' 
 X  | OR 
 X  ; 
 X 
 Xterm  : factor 
 X  | term mult_op factor 
 X  ; 
 Xmult_op  : '*' 
 X  | '/' 
 X  | DIV 
 X  | MOD 
 X  | AND 
 X  ; 
 X 
 Xfactor  : variable  /* could be a const_ident of fn_call*/ 
 X  | unsigned_lit 
 X  | '(' expression ')' 
 X /* | function_call  */ 
 X  | set 
 X  | NOT factor 
 X  ; 
 X 
 Xunsigned_lit : unsigned_num 
 X  | STRING   /*type is char if len=1*/ 
 X  | NIL 
 X  ; 
 X/* 
 Xfunction_call : ident actual_params 
 X  ; 
 X*/ 
 X 
 Xset  : '[' member_list ']' 
 X  ; 
 Xmember_list : /*empty*/ 
 X  | members 
 X  ; 
 Xmembers  : members ',' member 
 X  | member 
 X  ; 
 Xmember  : expression 
 X  | expression DOTDOT expression 
 X  ; 
 X 
 X/* kludge */ 
 Xvariable : ident actual_params /* check variable, const_id, fn_call */ 
 X  | variable '[' expressions ']' 
 X  | variable '.' ident 
 X  | variable '^' 
 X  ; 
 Xexpressions : expressions ',' expression 
 X  | expression 
 X  ; 
 Xrecord_var : variable 
 X  ; 
 Xident  : IDENTIFIER 
 X  ; 
 Xnewident : IDENTIFIER 
 X      { 
 X   if(param_level<2) 
 X       printf("%s\t%s\n", its_a, lastident); 
 X      } 
 X  ; 
 X%%   /*start of routines*/ 
 X 
 Xyyerror(msg) char *msg; 
 X{ 
 X    if(msg==NULL || *msg=='\0') 
 X fprintf(stderr, "Error at %s near line %d\n", 
 X    token_name(yychar), yylineno); 
 X    else 
 X fprintf(stderr, "Error at %s near line %d : %s\n", 
 X    token_name(yychar), yylineno, msg); 
 X    exit(1); 
 X} 
 X 
 Xparser_info() 
 X{ 
 X    printf("\n%d line%s parsed\n", yylineno, plural(yylineno)); 
 X} 
 X 
 X 
 Xinternal_error(s,a1,a2,a3,a4) 
 X{ 
 X    fprintf(stderr, "Internal error: "); 
 X    fprintf(stderr, s, a1, a2, a3, a4); 
 X    exit(2); 
 X} 
 X 
 Xwarning(fmt, a1, a2, a3, a4) 
 X{ 
 X    fprintf(stderr, "Warning line %d: ", yylineno); 
 X    fprintf(stderr, fmt, a1, a2, a3, a4); 
 X    fprintf(stderr, "\n"); 
 X} 
 X 
 Xmain() 
 X{ 
 X    yyparse(); 
 X} 
SHAR_EOF 
if test 7510 -ne "`wc -c < 'pascal.y'`" 
then 
 echo shar: "error transmitting 'pascal.y'" '(should have been 7510 characte 
rs)' 
fi 
fi 
echo shar: "extracting 'types.h'" '(115 characters)' 
if test -f 'types.h' 
then 
 echo shar: "will not over-write existing file 'types.h'" 
else 
sed 's/^ X//' << \SHAR_EOF > 'types.h' 

 X#define pluralsuffix(num,suffix) ((num)==1?"":(suffix)) 
 X#define plural(num) pluralsuffix(num,"s") 
 X#define item int 
SHAR_EOF 
if test 115 -ne "`wc -c < 'types.h'`" 
then 
 echo shar: "error transmitting 'types.h'" '(should have been 115 characters 
)' 
fi 
fi 
exit 0 
# End of shell archive 
  
-- 
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.