3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 11:59:43 +01:00

c2english: minor clean-ups

This commit is contained in:
Pragmatic Software 2021-08-15 11:18:28 -07:00
parent 1b13123474
commit 8115169729
2 changed files with 247 additions and 263 deletions

View File

@ -64,78 +64,77 @@ undefinition:
'undef' identifier <skip: '[ \t]*'> "\n" 'undef' identifier <skip: '[ \t]*'> "\n"
{ {
@macros = grep { $_ ne $item{identifier} } @macros; @macros = grep { $_ ne $item{identifier} } @macros;
$return = "\nAnnul the definition of $item{identifier}.\n"; "\nAnnul the definition of $item{identifier}.\n"
} }
inclusion: inclusion:
'include' '<' filename '>' <skip: '[ \t]*'> "\n" 'include' '<' filename '>' <skip: '[ \t]*'> "\n"
{ $return = "\nInclude the header $item{filename}.\n"; } { "\nInclude the header $item{filename}.\n" }
| 'include' '"' filename '"' <skip: '[ \t]*'> "\n" | 'include' '"' filename '"' <skip: '[ \t]*'> "\n"
{ $return = "\nInclude the source file $item{filename}.\n"; } { "\nInclude the source file $item{filename}.\n" }
| 'include' token | 'include' token
{ $return = "\nImport code noted by the token $item{token}.\n"; } { "\nImport code noted by the token $item{token}.\n" }
filename: filename:
/[_\.\-\w\/]+/ /[_\.\-\w\/]+/
line: line:
'line' constant ('"' filename '"' 'line' constant ('"' filename '"'
{ $return = "and filename $item{filename}"; } { "and filename $item{filename}" }
)(?) <skip: '[ \t]*'> "\n" )(?) <skip: '[ \t]*'> "\n"
{ $return = "\nThis is line number $item{constant} " . join('', @{$item[-3]}) . ".\n"; } { "\nThis is line number $item{constant} " . join('', @{$item[-3]}) . ".\n" }
error: error:
'error' token_sequence(?) <skip: '[ \t]*'> "\n" 'error' token_sequence(?) <skip: '[ \t]*'> "\n"
{ $return = "Stop compilation with error \"" . join('', @{$item{'token_sequence(?)'}}) . "\".\n"; } { "Stop compilation with error \"" . join('', @{$item{'token_sequence(?)'}}) . "\".\n" }
pragma: pragma:
'pragma' token_sequence(?) <skip: '[ \t]*'> "\n" 'pragma' token_sequence(?) <skip: '[ \t]*'> "\n"
{ {
my $pragma = join('',@{$item{'token_sequence(?)'}}); my $pragma = join('',@{$item{'token_sequence(?)'}});
if ($pragma) { $pragma = ' "$pragma"'; } if ($pragma) { $pragma = ' "$pragma"'; }
$return = "Process a compiler-dependent pragma$pragma.\n"; "Process a compiler-dependent pragma$pragma.\n"
} }
preproc_conditional: preproc_conditional:
if_line[matchrule => $arg{matchrule}] if_line[matchrule => $arg{matchrule}]
{ $rule_name = $arg{matchrule}; } { $rule_name = $arg{matchrule}; }
<matchrule: $rule_name>(s?) <matchrule: $rule_name>(s?)
{ $return = $item{if_line} . join('',@{$item[-1]}); } { $item{if_line} . join('',@{$item[-1]}) }
(elif_parts[matchrule => $rule_name])(?) (elif_parts[matchrule => $rule_name])(?)
(else_parts[matchrule => $rule_name])(?) (else_parts[matchrule => $rule_name])(?)
{ $return .= join('',@{$item[-2]}) . join('',@{$item[-1]}); } { join('',@{$item[-2]}) . join('',@{$item[-1]}) }
'#' 'endif' '#' 'endif'
{ $return .= "End preprocessor conditional.\n"; } { "End preprocessor conditional.\n" }
if_line: if_line:
'ifdef' identifier <skip: '[ \t]*'> "\n" 'ifdef' identifier <skip: '[ \t]*'> "\n"
{ $return .= "If the macro $item{identifier} is defined, then ^L"; } { "If the macro $item{identifier} is defined, then ^L" }
| 'ifndef' identifier <skip: '[ \t]*'> "\n" | 'ifndef' identifier <skip: '[ \t]*'> "\n"
{ $return .= "If the macro $item{identifier} is not defined, then ^L"; } { "If the macro $item{identifier} is not defined, then ^L" }
| 'if' constant_expression <skip: '[ \t]*'> "\n" | 'if' constant_expression <skip: '[ \t]*'> "\n"
{ $return .= "If the preprocessor condition^L $item{constant_expression} is true, then ^L"; } { "If the preprocessor condition^L $item{constant_expression} is true, then ^L" }
elif_parts: elif_parts:
('#' 'elif' constant_expression ('#' 'elif' constant_expression
{ $return .= "Otherwise, if the preprocessor condition $item{constant_expression} is true, then ^L"; } { "Otherwise, if the preprocessor condition $item{constant_expression} is true, then ^L" }
(<matchrule: $rule_name> )[matchrule => $arg{matchrule}](s?) (<matchrule: $rule_name> )[matchrule => $arg{matchrule}](s?)
{ $return .= join('',@{$item[-1]}); } { join('',@{$item[-1]}) }
)(s) )(s)
{ $return = join('', @{$item[-1]}); } { join('', @{$item[-1]}) }
else_parts: else_parts:
'#' 'else' '#' 'else'
{ $rule_name = $arg{matchrule}; } { $rule_name = $arg{matchrule}; }
(<matchrule: $rule_name>)[matchrule => $arg{matchrule}](s?) (<matchrule: $rule_name>)[matchrule => $arg{matchrule}](s?)
{ $return = "Otherwise, ^L" . join('',@{$item[-1]}); } { "Otherwise, ^L" . join('',@{$item[-1]}) }
token_sequence: token_sequence:
token(s) token(s)
{ $return = join(' ', @{$item[1]}); } { join(' ', @{$item[1]}) }
token: token:
<skip: '[ \t]*'> /\S+/ <skip: '[ \t]*'> /\S+/
{ $return = $item[-1]; }
external_declaration: external_declaration:
declaration[context => 'external declaration'] declaration[context => 'external declaration']
@ -262,7 +261,7 @@ statement_list:
if ($preproc) { $return = $preproc . $return; } if ($preproc) { $return = $preproc . $return; }
} }
statement_list(?) statement_list(?)
{ $return .= join('',@{$item{'statement_list(?)'}}); } { join('',@{$item{'statement_list(?)'}}) }
statement: statement:
jump_statement jump_statement
@ -367,13 +366,11 @@ selection_statement:
$return .= "^L$item{statement}"; $return .= "^L$item{statement}";
} }
('else' statement[context => "$arg{context}|else block"] ('else' statement[context => "$arg{context}|else block"]
{ $return = "Otherwise, ^L$item{statement}"; } { "Otherwise, ^L$item{statement}" }
)(?) )(?)
{ $return .= join('',@{$item[-1]}); } { $return .= join('',@{$item[-1]}); }
| 'switch' '(' expression[context => 'switch conditional'] ')' statement[context => "$arg{context}|switch"] | 'switch' '(' expression[context => 'switch conditional'] ')' statement[context => "$arg{context}|switch"]
{ { "When given the expression ^L$item{expression}, ^L$item{statement}" }
$return = "When given the expression ^L$item{expression}, ^L$item{statement}";
}
jump_statement: jump_statement:
'break' ';' 'break' ';'
@ -388,7 +385,7 @@ jump_statement:
} }
} }
| 'continue' ';' | 'continue' ';'
{ $return = "Return to the top of the current loop.\n"; } { "Return to the top of the current loop.\n" }
| 'return' <commit> expression[context => "$arg{context}|return expression"](?) ';' | 'return' <commit> expression[context => "$arg{context}|return expression"](?) ';'
{ {
my $expression = join('', @{$item{'expression(?)'}}); my $expression = join('', @{$item{'expression(?)'}});
@ -425,9 +422,9 @@ expression_statement:
labeled_statement: labeled_statement:
identifier ':' statement[context => 'label'] (';')(?) identifier ':' statement[context => 'label'] (';')(?)
{ $return = "Let there be a label $item{identifier}.\n$item{statement}"; } { "Let there be a label $item{identifier}.\n$item{statement}" }
| ('case' constant_expression | ('case' constant_expression
{ $return = $item{constant_expression}; } { $item{constant_expression} }
':')(s) ':')(s)
{ {
my @items = @{$item[1]}; my @items = @{$item[1]};
@ -450,7 +447,7 @@ labeled_statement:
$return = "If it has the value $item[-2], ^L$statements$last"; $return = "If it has the value $item[-2], ^L$statements$last";
} }
| 'default' ':' statement | 'default' ':' statement
{ $return = "In the default case, ^L$item{statement}"; } { "In the default case, ^L$item{statement}" }
expression: expression:
<leftop: assignment_expression ',' assignment_expression> <leftop: assignment_expression ',' assignment_expression>
@ -507,118 +504,118 @@ conditional_expression:
conditional_ternary_expression: conditional_ternary_expression:
'?' expression ':' conditional_expression '?' expression ':' conditional_expression
{ $return = [$item{expression}, $item{conditional_expression}]; } { [$item{expression}, $item{conditional_expression}] }
| {""} | {""}
assignment_operator: assignment_operator:
'=' '='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['assigning to^L', 'the value^L' ]; ['assigning to^L', 'the value^L' ]
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Assign to^L', 'the value^L' ]; ['Assign to^L', 'the value^L' ]
} else { } else {
$return = 'which is assigned to be^L'; 'which is assigned to be^L'
} }
} }
| '+=' | '+='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['incrementing^L','by^L']; ['incrementing^L','by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Increment^L','by^L']; ['Increment^L','by^L']
} else { } else {
$return = 'which is incremented by^L'; 'which is incremented by^L'
} }
} }
| '-=' | '-='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['decrementing^L' , 'by^L']; ['decrementing^L' , 'by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Decrement^L', 'by^L']; ['Decrement^L', 'by^L']
} else { } else {
$return = 'which is decremented by^L'; 'which is decremented by^L'
} }
} }
| '*=' | '*='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['multiplying^L' , 'by^L']; ['multiplying^L' , 'by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Multiply^L' , 'by^L']; ['Multiply^L' , 'by^L']
} else { } else {
$return = 'which is multiplied by^L'; 'which is multiplied by^L'
} }
} }
| '/=' | '/='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['dividing^L' , 'by^L' ]; ['dividing^L' , 'by^L' ]
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Divide^L' , 'by^L' ]; ['Divide^L' , 'by^L' ]
} else { } else {
$return = 'which is divided by^L'; 'which is divided by^L'
} }
} }
| '%=' | '%='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['reducing^L', 'to modulo ^L'] ; ['reducing^L', 'to modulo ^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Reduce^L', 'to modulo ^L'] ; ['Reduce^L', 'to modulo ^L']
} else { } else {
$return = 'which is reduced to modulo^L'; 'which is reduced to modulo^L'
} }
} }
| '<<=' | '<<='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['bit-shifting^L', 'left by^L']; ['bit-shifting^L', 'left by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Bit-shift^L', 'left by^L']; ['Bit-shift^L', 'left by^L']
} else { } else {
$return = 'which is bit-shifted left by^L'; 'which is bit-shifted left by^L'
} }
} }
| '>>=' | '>>='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['bit-shifting^L', 'right by^L']; ['bit-shifting^L', 'right by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Bit-shift^L', 'right by^L']; ['Bit-shift^L', 'right by^L']
} else { } else {
$return = 'which is bit-shifted right by^L'; 'which is bit-shifted right by^L'
} }
} }
| '&=' | '&='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['bitwise-ANDing^L', 'by^L' ]; ['bitwise-ANDing^L', 'by^L' ]
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Bitwise-AND^L', 'by^L' ]; ['Bitwise-AND^L', 'by^L' ]
} else { } else {
$return = 'which is bitwise-ANDed by^L'; 'which is bitwise-ANDed by^L'
} }
} }
| '^=' | '^='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['exclusive-ORing^L','by^L']; ['exclusive-ORing^L','by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Exclusive-OR^L','by^L']; ['Exclusive-OR^L','by^L']
} else { } else {
$return = 'which is exclusive-ORed by^L'; 'which is exclusive-ORed by^L'
} }
} }
| '|=' | '|='
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
$return = ['bitwise-ORing^L', 'by^L']; ['bitwise-ORing^L', 'by^L']
} elsif ($arg{context} =~ /statement$/) { } elsif ($arg{context} =~ /statement$/) {
$return = ['Bitwise-OR^L', 'by^L']; ['Bitwise-OR^L', 'by^L']
} else { } else {
$return = 'which is bitwise-ORed by^L'; 'which is bitwise-ORed by^L'
} }
} }
@ -645,58 +642,58 @@ logical_OR_AND_expression:
} }
log_OR_AND_bit_or_and_eq: log_OR_AND_bit_or_and_eq:
'||' { $return = ' or ^L'; } '||' { ' or ^L' }
| '&&' { $return = ' and ^L'; } | '&&' { ' and ^L' }
| '|' { $return = ' bitwise-ORed by ^L'; } | '|' { ' bitwise-ORed by ^L' }
| '&' { $return = ' bitwise-ANDed by ^L'; } | '&' { ' bitwise-ANDed by ^L' }
| '^' { $return = ' bitwise-XORed by ^L';} | '^' { ' bitwise-XORed by ^L'}
| '==' { $return = ' is equal to ^L'; } | '==' { ' is equal to ^L' }
| '!=' { $return = ' is not equal to ^L'; } | '!=' { ' is not equal to ^L' }
rel_mul_add_ex_op: rel_mul_add_ex_op:
'+' { $return = ' plus ^L'; } '+' { ' plus ^L' }
| '-' { $return = ' minus ^L'; } | '-' { ' minus ^L' }
| '*' { $return = ' times ^L'; } | '*' { ' times ^L' }
| '/' { $return = ' divided by ^L'; } | '/' { ' divided by ^L' }
| '%' { $return = ' modulo ^L'; } | '%' { ' modulo ^L' }
| '<<' { $return = ' shifted left by ^L'; } | '<<' { ' shifted left by ^L' }
| '>>' { $return = ' shifted right by ^L'; } | '>>' { ' shifted right by ^L' }
| '>=' { $return = ' is greater than or equal to ^L'; } | '>=' { ' is greater than or equal to ^L' }
| "<=" { $return = ' is less than or equal to ^L'; } | "<=" { ' is less than or equal to ^L' }
| '>' { $return = ' is greater than ^L'; } | '>' { ' is greater than ^L' }
| '<' { $return = ' is less than ^L'; } | '<' { ' is less than ^L' }
unary_operator: unary_operator:
'&' { $return = 'the address of ^L'; } '&' { 'the address of ^L' }
| '*' { $return = 'the dereference of ^L'; } | '*' { 'the dereference of ^L' }
| '+' { $return = ''; } | '+' { '' }
| '-' ...identifier { $return = 'negative ^L'; } | '-' ...identifier { 'negative ^L' }
| '-' { $return = 'minus ^L'; } | '-' { 'minus ^L' }
| '~' { $return = "the one's complement of ^L"; } | '~' { "the one's complement of ^L" }
| '!' '!' { $return = 'the normalized boolean value of ^L'; } | '!' '!' { 'the normalized boolean value of ^L' }
| '!' | '!'
{ {
if ($arg{context} =~ /conditional/) { if ($arg{context} =~ /conditional/) {
$return = ['', ' is false']; ['', ' is false']
} else { } else {
$return = 'the logical negation of ^L'; 'the logical negation of ^L'
} }
} }
rel_add_mul_shift_expression: rel_add_mul_shift_expression:
cast_expression ...';' cast_expression ...';'
{ $return = $item{cast_expression}; } { $item{cast_expression} }
| <leftop: cast_expression rel_mul_add_ex_op cast_expression> | <leftop: cast_expression rel_mul_add_ex_op cast_expression>
{ $return = join('', @{$item[1]}); } { join('', @{$item[1]}) }
closure: closure:
',' | ';' | ')' ',' | ';' | ')'
cast_expression: cast_expression:
'(' type_name ')' cast_expression[context => 'recast'] '(' type_name ')' cast_expression[context => 'recast']
{ $return = "$item{cast_expression} converted to $item{type_name}"; } { "$item{cast_expression} converted to $item{type_name}" }
| unary_expression | unary_expression
{ $return = $item{unary_expression}; } { $item{unary_expression} }
Static_assert: Static_assert:
'_Static_assert' '_Static_assert'
@ -706,12 +703,12 @@ static_assert_declaration:
Static_assert '(' constant_expression[context => 'static assert'] ',' string ')' ';' Static_assert '(' constant_expression[context => 'static assert'] ',' string ')' ';'
{ {
my $expression = ::istrue $item{constant_expression}; my $expression = ::istrue $item{constant_expression};
$return = "Halt compilation and produce the diagnostic $item{string} unless $expression.\n"; "Halt compilation and produce the diagnostic $item{string} unless $expression.\n"
} }
declaration_list: declaration_list:
preproc[context => 'statement'](?) declaration(s) preproc[context => 'statement'](?) declaration(s)
{ $return = join('', @{$item{'preproc(?)'}}) . join('', @{$item{'declaration(s)'}}); } { join('', @{$item{'preproc(?)'}}) . join('', @{$item{'declaration(s)'}}) }
declaration: declaration:
declaration_specifiers init_declarator_list(?) ';' declaration_specifiers init_declarator_list(?) ';'
@ -904,9 +901,7 @@ init_declarator_list:
init_declarator: init_declarator:
declarator[context => "$arg{context}|init_declarator"] declarator[context => "$arg{context}|init_declarator"]
{ { $return = $item{declarator} }
$return = $item{declarator};
}
('=' initializer)(?) ('=' initializer)(?)
{ {
my $init = join('',@{$item[-1]}); my $init = join('',@{$item[-1]});
@ -918,7 +913,7 @@ init_declarator:
initializer: initializer:
designation initializer designation initializer
{ $return = "$item[1] $item[2]"; } { "$item[1] $item[2]" }
| comment(?) assignment_expression[context => "$arg{context}|initializer expression"] comment(?) | comment(?) assignment_expression[context => "$arg{context}|initializer expression"] comment(?)
{ {
$return = $item[2]; $return = $item[2];
@ -932,15 +927,15 @@ initializer:
} }
} }
| '{' comment(?) initializer_list (',' )(?) '}' | '{' comment(?) initializer_list (',' )(?) '}'
{ $return = '{' . $item{'initializer_list'} . '}'; } { '{' . $item{'initializer_list'} . '}' }
initializer_list: initializer_list:
<leftop: initializer ',' initializer > <leftop: initializer ',' initializer >
{ $return = join(', ', @{$item[1]}); } { join(', ', @{$item[1]}) }
designation: designation:
designator_list '=' designator_list '='
{ $return = $item{designator_list}; } { $item{designator_list} }
designator_list: designator_list:
designator(s) designator(s)
@ -977,11 +972,10 @@ designator:
$return = $expression; $return = $expression;
} }
| '.' identifier | '.' identifier
{ $return = "the member $item{identifier}"; } { "the member $item{identifier}" }
unary_expression: unary_expression:
postfix_expression postfix_expression
{ $return = $item{postfix_expression}; }
| '++' unary_expression | '++' unary_expression
{ {
if ($arg{context} =~ /for init/) { if ($arg{context} =~ /for init/) {
@ -1047,11 +1041,9 @@ unary_expression:
} }
} }
| Alignof '(' type_name ')' | Alignof '(' type_name ')'
{ $return = "the alignment of the type $item{type_name}"; } { "the alignment of the type $item{type_name}" }
| 'offsetof' '(' type_name[context => 'offsetof'] ',' identifier ')' | 'offsetof' '(' type_name[context => 'offsetof'] ',' identifier ')'
{ { "the offset, in bytes, of member $item{identifier} from the beginning of $item{type_name}" }
$return = "the offset, in bytes, of member $item{identifier} from the beginning of $item{type_name}";
}
Alignof: Alignof:
'_Alignof' '_Alignof'
@ -1311,7 +1303,7 @@ primary_expression:
generic_selection: generic_selection:
'_Generic' '(' assignment_expression ',' generic_assoc_list ')' '_Generic' '(' assignment_expression ',' generic_assoc_list ')'
{ $return = "a generic-selection on $item{assignment_expression} yielding $item{generic_assoc_list}"; } { "a generic-selection on $item{assignment_expression} yielding $item{generic_assoc_list}" }
generic_assoc_list: generic_assoc_list:
<leftop: generic_association ',' generic_association> <leftop: generic_association ',' generic_association>
@ -1326,9 +1318,9 @@ generic_assoc_list:
generic_association: generic_association:
type_name ':' assignment_expression type_name ':' assignment_expression
{ $return = "$item{assignment_expression} in the case that it has type $item{type_name}"; } { "$item{assignment_expression} in the case that it has type $item{type_name}" }
| 'default' ':' assignment_expression | 'default' ':' assignment_expression
{ $return = "$item{assignment_expression} in the default case"; } { "$item{assignment_expression} in the default case" }
Alignas: Alignas:
'_Alignas' '_Alignas'
@ -1336,13 +1328,11 @@ Alignas:
alignment_specifier: alignment_specifier:
Alignas '(' type_name ')' Alignas '(' type_name ')'
{ { "with alignment of the type $item{type_name}" }
$return = "with alignment of the type $item{type_name}";
}
| Alignas '(' constant_expression ')' | Alignas '(' constant_expression ')'
{ {
my $plural = $item{constant_expression} != 1 ? 's' : ''; my $plural = $item{constant_expression} != 1 ? 's' : '';
$return = "with alignment of $item{constant_expression} byte$plural between objects"; "with alignment of $item{constant_expression} byte$plural between objects"
} }
declarator: declarator:
@ -1358,14 +1348,14 @@ declarator:
| pointer direct_declarator(s) | pointer direct_declarator(s)
{ {
push @{$item{'direct_declarator(s)'}}, $item{pointer}; push @{$item{'direct_declarator(s)'}}, $item{pointer};
$return = $item{'direct_declarator(s)'}; $item{'direct_declarator(s)'}
} }
direct_declarator: direct_declarator:
identifier ':' constant identifier ':' constant
{ {
my $bits = $item{constant} == 1 ? "$item{constant} bit" : "$item{constant} bits"; my $bits = $item{constant} == 1 ? "$item{constant} bit" : "$item{constant} bits";
$return = [$item{identifier}, "bit-field of $bits"]; [$item{identifier}, "bit-field of $bits"]
} }
| identifier[context => 'direct_declarator'] array_declarator(s?) | identifier[context => 'direct_declarator'] array_declarator(s?)
{ {
@ -1378,14 +1368,14 @@ direct_declarator:
| '(' declarator ')' array_declarator(s) | '(' declarator ')' array_declarator(s)
{ {
push @{$item{declarator}}, join(' ', @{$item{'array_declarator(s)'}}); push @{$item{declarator}}, join(' ', @{$item{'array_declarator(s)'}});
$return = $item{declarator}; $item{declarator}
} }
| '(' parameter_type_list ')' | '(' parameter_type_list ')'
{ $return = "function taking $item{parameter_type_list} and returning"; } { "function taking $item{parameter_type_list} and returning" }
| '(' declarator array_declarator(s) ')' | '(' declarator array_declarator(s) ')'
{ $return = $item{'declarator'} . join(' ', @{$item{'array_declarator(s)'}}) } { $item{'declarator'} . join(' ', @{$item{'array_declarator(s)'}}) }
| '(' declarator ')' | '(' declarator ')'
{ $return = $item{declarator}; } { $item{declarator} }
array_qualifiers: array_qualifiers:
type_qualifier_list array_qualifiers(?) type_qualifier_list array_qualifiers(?)
@ -1498,13 +1488,13 @@ parameter_list:
parameter_declaration: parameter_declaration:
declaration_specifiers declarator declaration_specifiers declarator
{ $return = [$item{declaration_specifiers}, $item{declarator}]; } { [$item{declaration_specifiers}, $item{declarator}] }
| '...' | '...'
{ $return = "variadic arguments"; } { "variadic arguments" }
| declaration_specifiers abstract_declarator(?) | declaration_specifiers abstract_declarator(?)
{ $return = [$item{declaration_specifiers}, $item{'abstract_declarator(?)'}]; } { [$item{declaration_specifiers}, $item{'abstract_declarator(?)'}] }
| '' | ''
{ $return = "unspecified arguments"; } { "unspecified arguments" }
abstract_declarator: abstract_declarator:
pointer(?) direct_abstract_declarator(s) pointer(?) direct_abstract_declarator(s)
@ -1517,11 +1507,11 @@ abstract_declarator:
direct_abstract_declarator: direct_abstract_declarator:
'(' abstract_declarator ')' '(' abstract_declarator ')'
{ $return = $item{abstract_declarator}; } { $item{abstract_declarator} }
| '[' ']' | '[' ']'
{ $return = 'array of unspecified length of'; } { 'array of unspecified length of' }
| '[' '*' ']' | '[' '*' ']'
{ $return = 'array of variable length of unspecified size of'; } { 'array of variable length of unspecified size of' }
| '[' array_qualifiers(?) assignment_expression(?) ']' | '[' array_qualifiers(?) assignment_expression(?) ']'
{ {
my $size; my $size;
@ -1557,9 +1547,9 @@ direct_abstract_declarator:
| DAD '[' ']' | DAD '[' ']'
| DAD '[' array_qualifiers(?) assignment_expression(?) ']' | DAD '[' array_qualifiers(?) assignment_expression(?) ']'
| '(' ')' | '(' ')'
{ $return = 'function taking unspecified arguments and returning'; } { 'function taking unspecified arguments and returning' }
| '(' parameter_type_list ')' | '(' parameter_type_list ')'
{ $return = "function taking $item{parameter_type_list} and returning"; } { "function taking $item{parameter_type_list} and returning" }
| DAD '(' ')' | DAD '(' ')'
| DAD '(' parameter_type_list ')' | DAD '(' parameter_type_list ')'
@ -1576,7 +1566,7 @@ identifier:
if (not grep { $_ eq $item{identifier_word} } @identifiers) { if (not grep { $_ eq $item{identifier_word} } @identifiers) {
push @identifiers, $item{identifier_word}; push @identifiers, $item{identifier_word};
} }
$return = $item{identifier_word}; $item{identifier_word}
} }
pointer: pointer:
@ -1594,19 +1584,19 @@ pointer:
type_qualifier_list: type_qualifier_list:
type_qualifier(s) type_qualifier(s)
{ $return = join(' ', @{$item{'type_qualifier(s)'}}); } { join(' ', @{$item{'type_qualifier(s)'}}) }
function_specifier: function_specifier:
'inline' 'inline'
| '_Noreturn' | '_Noreturn'
| 'noreturn' | 'noreturn'
{ $return = '_Noreturn'; } { '_Noreturn' }
declaration_specifiers: declaration_specifiers:
comment[context => 'declaration_specifiers'] declaration_specifiers(s) comment[context => 'declaration_specifiers'] declaration_specifiers(s)
{ $return = "$item{comment} " . join(' ', @{$item{'declaration_specifiers(s)'}}); } { "$item{comment} " . join(' ', @{$item{'declaration_specifiers(s)'}}) }
| type_specifier ...identifier | type_specifier ...identifier
{ $return = $item{type_specifier}; } { $item{type_specifier} }
| storage_class_specifier declaration_specifiers(?) | storage_class_specifier declaration_specifiers(?)
{ {
my $decl_spec = join(' ', @{$item{'declaration_specifiers(?)'}}); my $decl_spec = join(' ', @{$item{'declaration_specifiers(?)'}});
@ -1652,40 +1642,40 @@ declaration_specifiers:
storage_class_specifier: storage_class_specifier:
'auto' 'auto'
{ $return = "with automatic storage-duration"; } { 'with automatic storage-duration' }
| 'extern' | 'extern'
{ {
if ($arg{context} eq 'function definition') { if ($arg{context} eq 'function definition') {
$return = "with external linkage"; 'with external linkage'
} else { } else {
$return = "with external linkage, possibly defined elsewhere"; 'with external linkage, possibly defined elsewhere'
} }
} }
| 'static' | 'static'
{ {
if ($arg{context} eq 'function definition') { if ($arg{context} eq 'function definition') {
$return = "with internal linkage"; 'with internal linkage'
} elsif ($arg{context} eq 'function definition statement') { } elsif ($arg{context} eq 'function definition statement') {
$return = "with life-time duration"; 'with life-time duration'
} else { } else {
$return = "with internal linkage and life-time duration"; 'with internal linkage and life-time duration'
} }
} }
| 'register' | 'register'
{ $return = "with a suggestion to be as fast as possible"; } { 'with a suggestion to be as fast as possible' }
| 'typedef' | 'typedef'
{ $return = 'type definition of'; } { 'type definition of' }
type_qualifier: type_qualifier:
'const' 'const'
| 'volatile' | 'volatile'
| 'restrict' | 'restrict'
| '_Atomic' | '_Atomic'
{ $return = 'atomic'; } { 'atomic' }
atomic_type_specifier: atomic_type_specifier:
'_Atomic' '(' type_name ')' '_Atomic' '(' type_name ')'
{ $return = "atomic $item{type_name}"; } { "atomic $item{type_name}" }
type_specifier: type_specifier:
<skip:''> /\s*/ <skip:''> /\s*/
@ -1715,7 +1705,7 @@ type_specifier:
| <skip:'[\s]*'> atomic_type_specifier | typedef_name | <skip:'[\s]*'> atomic_type_specifier | typedef_name
| 'double' | 'float' | 'char' | 'short' | 'int' | 'long' | 'double' | 'float' | 'char' | 'short' | 'int' | 'long'
) .../\W/ ) .../\W/
{ $return = $item[3]; } { $item[3] }
typedef_name: typedef_name:
identifier identifier
@ -1764,7 +1754,7 @@ struct_declaration_list:
struct_declaration: struct_declaration:
comment(s?) declaration[context => 'struct member'] comment(s?) comment(s?) declaration[context => 'struct member'] comment(s?)
{ $return = join('', @{$item[1]}) . $item{declaration} . join('', @{$item[-1]}); } { join('', @{$item[1]}) . $item{declaration} . join('', @{$item[-1]}) }
type_name: type_name:
specifier_qualifier_list abstract_declarator(?) specifier_qualifier_list abstract_declarator(?)
@ -1788,9 +1778,9 @@ specifier_qualifier_list:
struct_or_union: struct_or_union:
comment(?) ('struct' comment(?) ('struct'
{ $return = 'a structure'; } { 'a structure' }
| 'union' | 'union'
{ $return = 'an union'; } { 'a union' }
) comment(?) ) comment(?)
{ {
shift @item; shift @item;
@ -1823,7 +1813,7 @@ enum_specifier:
} }
| 'enum' identifier | 'enum' identifier
{ $return = "an enumeration of type $item{identifier}"; } { "an enumeration of type $item{identifier}" }
enumerator_list: enumerator_list:
<leftop:enumerator ',' enumerator> <leftop:enumerator ',' enumerator>
@ -1931,7 +1921,7 @@ constant:
identifier_word: identifier_word:
/[a-z_\$][a-z0-9_]*/i /[a-z_\$][a-z0-9_]*/i
{ $return = "`$item[-1]`"; } { "`$item[1]`" }
string: string:
(/(u8|u|U|L)?(?:\"(?:\\\"|(?!\").)*\")/)(s) (/(u8|u|U|L)?(?:\"(?:\\\"|(?!\").)*\")/)(s)

View File

@ -6,128 +6,122 @@
use strict; use strict;
use warnings; use warnings;
use lib "."; use lib '.';
use Parse::RecDescent; use Parse::RecDescent;
use Getopt::Std; use Getopt::Std;
use Data::Dumper;
our ($opt_T, $opt_t, $opt_o, $opt_P);
getopts('TPto:');
if ($opt_T ) {
$::RD_TRACE = 1;
} else {
undef $::RD_TRACE ;
}
$::RD_HINT = 1;
$Parse::RecDescent::skip = '\s*';
my $parser;
if($opt_P or !eval { require PCGrammar }) {
precompile_grammar();
require PCGrammar;
}
$parser = PCGrammar->new() or die "Bad grammar!\n";
if ($opt_o) {
open(OUTFILE, ">>$opt_o");
*STDOUT = *OUTFILE{IO};
}
my $text = "";
foreach my $arg (@ARGV) {
print STDERR "Opening file $arg\n";
open(CFILE, "$arg") or die "Could not open $arg.\n";
local $/;
$text = <CFILE>;
close(CFILE);
print STDERR "parsing...\n";
# for debugging...
if ($opt_t) {
$::RD_TRACE = 1;
} else {
undef $::RD_TRACE;
}
my $result = $parser->startrule(\$text) or die "Bad text!\n$text\n";
$text =~ s/^\s+//g;
$text =~ s/\s+$//g;
if(length $text) {
print "Bad parse at: $text";
} else {
my $output = join('', flatten($result));
# beautification
my @quotes;
$output =~ s/(?:\"((?:\\\"|(?!\").)*)\")/push @quotes, $1; '"' . ('-' x length $1) . '"'/ge;
$output =~ s/\ban un/a un/g;
$output =~ s/\ban UTF/a UTF/g;
$output =~ s/the value the expression/the value of the expression/g;
$output =~ s/the value the member/the value of the member/g;
$output =~ s/the value the/the/g;
$output =~ s/of evaluate/of/g;
$output =~ s/the evaluate the/the/g;
$output =~ s/by evaluate the/by the/g;
$output =~ s/the a /the /g;
$output =~ s/Then if it has the value/If it has the value/g;
$output =~ s/result of the expression a generic-selection/result of a generic-selection/g;
$output =~ s/the result of the expression (an?) (16-bit character|32-bit character|wide character|UTF-8) string/$1 $2 string/gi;
$output =~ s/the function a generic-selection/the function resulting from a generic-selection/g;
$output =~ s/\.\s+Then exit switch block/ and then exit switch block/g;
$output =~ s/,\././g;
$output =~ s/of unspecified length //g;
while($output =~ s/const const/const/g){};
foreach my $quote (@quotes) {
next unless $quote;
$output =~ s/"-+"/"$quote"/;
}
print $output;
}
}
sub precompile_grammar { sub precompile_grammar {
print STDERR "Precompiling grammar...\n"; print STDERR "Precompiling grammar...\n";
open GRAMMAR, 'CGrammar.pm' or die "Could not open CGrammar.pm: $!"; open GRAMMAR, 'CGrammar.pm' or die "Could not open CGrammar.pm: $!";
local $/; local $/;
my $grammar = <GRAMMAR>; my $grammar = <GRAMMAR>;
close GRAMMAR; close GRAMMAR;
Parse::RecDescent->Precompile($grammar, "PCGrammar") or die "Could not precompile: $!";
Parse::RecDescent->Precompile($grammar, "PCGrammar") or die "Could not precompile: $!";
} }
sub flatten { map { ref eq 'ARRAY' ? flatten(@$_) : $_ } @_ } sub flatten {
map { ref eq 'ARRAY' ? flatten(@$_) : $_ } @_
}
sub isfalse { sub isfalse {
return istrue($_[0], 'zero'); istrue($_[0], 'zero')
} }
sub istrue { sub istrue {
my @parts = split /(?<!,) and /, $_[0]; my @parts = split /(?<!,) and /, $_[0];
my $truthy = defined $_[1] ? $_[1] : 'nonzero'; my $truthy = defined $_[1] ? $_[1] : 'nonzero';
my ($result, $and) = ('', ''); my ($result, $and) = ('', '');
foreach my $part (@parts) { foreach my $part (@parts) {
$result .= $and; $result .= $and;
if($part !~ /(discard the result|result discarded|greater|less|equal|false$)/) { if($part !~ /(discard the result|result discarded|greater|less|equal|false$)/) {
$result .= "$part is $truthy"; $result .= "$part is $truthy";
} else { } else {
$result .= $part; $result .= $part;
}
$and = ' and ';
} }
$and = ' and '; $result =~ s/is $truthy and the result discarded/is evaluated and the result discarded/g;
} $result =~ s/is ((?:(?!evaluated).)+) and the result discarded/is evaluated to be $1 and the result discarded/g;
$result =~ s/is $truthy and the result discarded/is evaluated and the result discarded/g; return $result;
$result =~ s/is ((?:(?!evaluated).)+) and the result discarded/is evaluated to be $1 and the result discarded/g;
return $result;
} }
sub main {
my ($opt_T, $opt_t, $opt_o, $opt_P);
getopts('TPto:');
if ($opt_T ) {
$::RD_TRACE = 1;
}
$::RD_HINT = 1;
$Parse::RecDescent::skip = '\s*';
my $parser;
if ($opt_P or !eval { require PCGrammar }) {
precompile_grammar();
require PCGrammar;
}
$parser = PCGrammar->new or die "Bad grammar!\n";
if ($opt_o) {
open(OUTFILE, ">>$opt_o");
*STDOUT = *OUTFILE{IO};
}
my $text;
foreach my $arg (@ARGV) {
print STDERR "Opening file $arg\n";
open(CFILE, "$arg") or die "Could not open $arg.\n";
local $/;
$text = <CFILE>;
close(CFILE);
print STDERR "parsing...\n";
my $result = $parser->startrule(\$text) or die "Bad text!\n$text\n";
$text =~ s/^\s+|\s+$//g;
if(length $text) {
print "Bad parse at: $text";
} else {
my $output = join('', flatten($result));
# beautification
my @quotes;
$output =~ s/(?:\"((?:\\\"|(?!\").)*)\")/push @quotes, $1; '"' . ('-' x length $1) . '"'/ge;
$output =~ s/\ban un/a un/g;
$output =~ s/\ban UTF/a UTF/g;
$output =~ s/the value the expression/the value of the expression/g;
$output =~ s/the value the member/the value of the member/g;
$output =~ s/the value the/the/g;
$output =~ s/of evaluate/of/g;
$output =~ s/the evaluate the/the/g;
$output =~ s/by evaluate the/by the/g;
$output =~ s/the a /the /g;
$output =~ s/Then if it has the value/If it has the value/g;
$output =~ s/result of the expression a generic-selection/result of a generic-selection/g;
$output =~ s/the result of the expression (an?) (16-bit character|32-bit character|wide character|UTF-8) string/$1 $2 string/gi;
$output =~ s/the function a generic-selection/the function resulting from a generic-selection/g;
$output =~ s/\.\s+Then exit switch block/ and then exit switch block/g;
$output =~ s/,\././g;
$output =~ s/of unspecified length //g;
while($output =~ s/const const/const/g){};
foreach my $quote (@quotes) {
next unless $quote;
$output =~ s/"-+"/"$quote"/;
}
print $output;
}
}
}
main;