%{ (* $Id: parser.mly 1870 2013-07-29 22:20:12Z gerd $ *) open Syntax %} %token LBRACKET RBRACKET %token LANGLE RANGLE %token LPAREN RPAREN %token LBRACE RBRACE %token STAR COMMA SEMICOLON COLON EQUAL MAPSTO %token <string> IDENT %token <string> QIDENT %token <string> INTLITERAL %token K_opaque K_string K_void K_unsigned K_int K_hyper %token K_float K_double K_quadruple K_bool %token K_enum K_struct K_union K_switch K_case K_default %token K_const K_typedef K_program K_version %token K_int32 K_int64 K_unboxed K_abstract K_managed %token K_tuple K_lowercase K_uppercase K_capitalize K_prefix K_equals %token IGNORE PERCENT %token <int*int> LINEFEED %token <int*string> SETFILE %token EOF %type <Syntax.xdr_def list> specification %start specification %% declaration: type_specifier declared_identifier { mk_decl $2 $1 } | type_specifier declared_identifier LBRACKET value RBRACKET { mk_decl $2 (T_array_fixed($4, $1)) } | type_specifier declared_identifier LANGLE value_opt RANGLE { let v_opt = $4 in match v_opt with None -> mk_decl $2 (T_array_unlimited $1) | Some v -> mk_decl $2 (T_array (v, $1)) } | K_opaque declared_identifier LBRACKET value RBRACKET { mk_decl $2 (T_opaque_fixed $4) } | K_opaque declared_identifier LANGLE value_opt RANGLE { let v_opt = $4 in match v_opt with None -> mk_decl $2 T_opaque_unlimited | Some v -> mk_decl $2 (T_opaque v) } | K_string declared_identifier LANGLE value_opt RANGLE { let v_opt = $4 in match v_opt with None -> mk_decl $2 (T_string_unlimited) | Some v -> mk_decl $2 (T_string v) } | K_managed K_string declared_identifier LANGLE value_opt RANGLE { let v_opt = $5 in let name = ( $3 ).xdr_name in match v_opt with None -> mk_decl $3 (T_mstring_unlimited name) | Some v -> mk_decl $3 (T_mstring(name,v)) } | type_specifier STAR declared_identifier { mk_decl $3 (T_option $1) } | K_void { mk_decl (mk_void_id()) T_void } ; value_opt: value { Some $1 } | { None } ; value: constant { let (sign,absval) = $1 in ref (Constant(sign,absval)) } | identifier { ref (Named_constant $1) } ; type_specifier: K_unsigned int_or_hyper { match $2 with T_int v -> T_uint v | T_hyper v -> T_uhyper v | _ -> assert false } | K_unsigned { T_uint !Options.default_int_variant } | int_or_hyper { $1 } | K_float { T_float } | K_double { T_double } | K_quadruple { error "Sorry, quadruple-precision floating point numbers are not supported" } | K_bool { T_bool } | enum_type_spec { $1 } | struct_type_spec { $1 } | union_type_spec { $1 } | identifier { T_refer_to (R_any, ref $1) } ; int_or_hyper: K_int { T_int !Options.default_int_variant } | K_hyper { T_hyper !Options.default_hyper_variant } | K_abstract K_int { T_int Abstract } | K_abstract K_hyper { T_hyper Abstract } | K_unboxed K_int { T_int Unboxed } | K_unboxed K_hyper { T_hyper Unboxed } | K_int32 K_int { T_int INT32 } | K_int64 K_int { T_int INT64 } | K_int64 K_hyper { T_hyper INT64 } ; enum_type_spec: K_enum enum_options enum_body { T_enum(mk_enum $2 $3) } | K_enum identifier { T_refer_to (R_enum, ref $2) } ; enum_body: LBRACE enum_body_list RBRACE { $2 } ; enum_body_list: declared_identifier EQUAL value { [ $1, $3 ] } | declared_identifier EQUAL value COMMA enum_body_list { ( $1, $3 ) :: $5 } ; enum_options: mangling_option enum_options { $1 :: $2 } | { [] } ; struct_type_spec: K_struct struct_options struct_body { T_struct(mk_struct $2 $3) } | K_struct identifier { T_refer_to (R_struct, ref $2) } ; struct_body: LBRACE struct_body_list RBRACE { $2 } ; struct_body_list: declaration SEMICOLON { [ $1 ] } | declaration SEMICOLON struct_body_list { $1 :: $3 } ; struct_options: struct_option struct_options { $1 :: $2 } | { [] } ; struct_option: K_tuple { `Tuple } | K_equals QIDENT { `Equals $2 } | mangling_option { ( $1 :> [ mangling_option | struct_option ] ) } ; union_type_spec: K_union union_body { T_union $2 } | K_union identifier { T_refer_to (R_union, ref $2) } ; union_body: union_options K_switch LPAREN declaration RPAREN LBRACE union_body_list union_default_opt RBRACE { mk_union $1 $4 $7 $8 } ; /* union_body_list: K_case value union_case_mapping COLON declaration SEMICOLON { [ $2, $3, $5 ] } | K_case value union_case_mapping COLON declaration SEMICOLON union_body_list { ( $2, $3, $5 ) :: $7 } ; */ union_body_list: union_case_list declaration SEMICOLON { let d = $2 in List.map (fun (v,mv) -> (v,mv,d)) $1 } | union_case_list declaration SEMICOLON union_body_list { let d = $2 in List.map (fun (v,mv) -> (v,mv,d)) $1 @ $4 } ; union_case_list: K_case value union_case_mapping COLON { [ $2, $3 ] } | K_case value union_case_mapping COLON union_case_list { ($2, $3) :: $5 } ; union_case_mapping: MAPSTO IDENT { Some $2 } | MAPSTO QIDENT { Some $2 } | { None } ; union_default_opt: K_default COLON declaration SEMICOLON { Some $3 } | { None } ; union_options: mangling_option union_options { $1 :: $2 } | { [] } ; mangling_option: K_lowercase { `Lowercase } | K_uppercase { `Uppercase } | K_capitalize { `Capitalize } | K_prefix QIDENT { `Prefix $2 } ; constant_def: K_const declared_identifier EQUAL constant SEMICOLON { Constdef($2, $4) } ; type_def: K_typedef declaration SEMICOLON { Typedef $2 } | K_enum declared_identifier enum_options enum_body SEMICOLON { Typedef (mk_decl $2 (T_enum(mk_enum $3 $4))) } | K_struct declared_identifier struct_options struct_body SEMICOLON { Typedef (mk_decl $2 (T_struct(mk_struct $3 $4))) } | K_union declared_identifier union_body SEMICOLON { Typedef (mk_decl $2 (T_union $3)) } ; program_def: K_program declared_identifier LBRACE program_def_list RBRACE EQUAL constant SEMICOLON { let (sign,nr) = $7 in if sign then error "Program numbers must not be negative"; mk_program $2 $4 nr } ; program_def_list: version_def { [ $1 ] } | version_def program_def_list { $1 :: $2 } ; version_def: K_version declared_identifier LBRACE version_def_list RBRACE EQUAL constant SEMICOLON { let (sign,nr) = $7 in if sign then error "Version numbers must not be negative"; mk_version $2 $4 nr } ; version_def_list: procedure_def { [ $1 ] } | procedure_def version_def_list { $1 :: $2 } ; procedure_def: type_specifier_or_void declared_identifier LPAREN parameter_list_or_void RPAREN EQUAL constant SEMICOLON { let (sign,nr) = $7 in if sign then error "Procdure numbers must not be negative"; mk_procedure $2 $4 $1 nr } ; type_specifier_or_void: type_specifier { $1 } | K_void { T_void } ; parameter_list: type_specifier { [ $1 ] } | type_specifier COMMA parameter_list { $1 :: $3 } ; parameter_list_or_void: parameter_list { $1 } | K_void { [ T_void ] } ; definition: type_def { $1 } | constant_def { $1 } | program_def { Progdef $1 } ; specification: definition specification { $1 :: $2 } | EOF { [] } ; identifier: IDENT { $1 } ; declared_identifier: IDENT { mk_id $1 } | IDENT MAPSTO IDENT { mk_mapped_id $1 $3 } | IDENT MAPSTO QIDENT { mk_mapped_id $1 $3 } ; constant: INTLITERAL { constant_of_string $1 } ; %%