mirror of
https://github.com/pragma-/pbot.git
synced 2024-12-24 11:42:35 +01:00
CGrammar: Several improvements in declarations; progress on pointers to functions
This commit is contained in:
Pragmatic Software
parent
1272de61fa
commit
476db3d6a9
@ -13,8 +13,8 @@ use warnings;
|
|||||||
# These are set automatically by the build/commit script
|
# These are set automatically by the build/commit script
|
||||||
use constant {
|
use constant {
|
||||||
BUILD_NAME => "PBot",
|
BUILD_NAME => "PBot",
|
||||||
BUILD_REVISION => 656,
|
BUILD_REVISION => 657,
|
||||||
BUILD_DATE => "2014-06-18",
|
BUILD_DATE => "2014-06-20",
|
||||||
};
|
};
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|||||||
@ -3,7 +3,7 @@
|
|||||||
# Warning: work-in-progress. Some things are incomplete or non-functional.
|
# Warning: work-in-progress. Some things are incomplete or non-functional.
|
||||||
#
|
#
|
||||||
# todo:
|
# todo:
|
||||||
# 1. the entire syntax for pointers to functions.
|
# 1. pointers to functions. (getting there)
|
||||||
# 2. preprocessor directives. (getting there)
|
# 2. preprocessor directives. (getting there)
|
||||||
|
|
||||||
{
|
{
|
||||||
@ -15,8 +15,8 @@ startrule:
|
|||||||
translation_unit
|
translation_unit
|
||||||
{
|
{
|
||||||
my $output = $item[-1];
|
my $output = $item[-1];
|
||||||
$output =~ s/\^L(\s*.)/\L$1/g; # lowercase specified characters
|
$output =~ s/\^L(\s*.?)/\L$1/g; # lowercase specified characters
|
||||||
$output =~ s/\^U(\s*.)/\U$1/g; # uppercase specified characters
|
$output =~ s/\^U(\s*.?)/\U$1/g; # uppercase specified characters
|
||||||
print $output;
|
print $output;
|
||||||
}
|
}
|
||||||
startrule(?)
|
startrule(?)
|
||||||
@ -25,7 +25,6 @@ translation_unit:
|
|||||||
comment
|
comment
|
||||||
| external_declaration
|
| external_declaration
|
||||||
| function_definition
|
| function_definition
|
||||||
| function_prototype
|
|
||||||
| preproc[matchrule => 'translation_unit']
|
| preproc[matchrule => 'translation_unit']
|
||||||
|
|
||||||
preproc:
|
preproc:
|
||||||
@ -144,75 +143,24 @@ external_declaration:
|
|||||||
declaration
|
declaration
|
||||||
|
|
||||||
function_definition:
|
function_definition:
|
||||||
declaration_specifiers(?) declarator[context => 'function_definition'] '(' parameter_type_list(?) ')'
|
declaration_specifiers(?) declarator[context => 'function definition'] compound_statement[context => 'function definition'](?)
|
||||||
'{' declaration_list(?) statement_list(?) '}'
|
|
||||||
{
|
{
|
||||||
|
print STDERR "wtf9\n", ::Dumper \%item;
|
||||||
my $declaration_specifiers = join('', @{$item{'declaration_specifiers(?)'}});
|
my $declaration_specifiers = join('', @{$item{'declaration_specifiers(?)'}});
|
||||||
my $parameter_list = join('', @{$item{'parameter_type_list(?)'}});
|
my $name = $item{declarator}->[0];
|
||||||
my $declaration_list = join('',@{$item{'declaration_list(?)'}});
|
my $parameter_list = $item{declarator}->[1];
|
||||||
my $statement_list = join('',@{$item{'statement_list(?)'}});
|
|
||||||
|
|
||||||
my $return_type = $item{declarator};
|
my $return_type;
|
||||||
my $name = $item{declarator};
|
if(@{$item{declarator}} > 2) {
|
||||||
|
$return_type = "$item{declarator}->[2] $declaration_specifiers";
|
||||||
$name =~ s/`[^`]+$/`/;
|
|
||||||
$return_type =~ s/`.*`\|?//;
|
|
||||||
|
|
||||||
if ($return_type =~ /\w/ ) {
|
|
||||||
$return_type .= " $declaration_specifiers";
|
|
||||||
} else {
|
} else {
|
||||||
$return_type = $declaration_specifiers;
|
$return_type = $declaration_specifiers;
|
||||||
}
|
}
|
||||||
|
|
||||||
$return = "\nLet $name be a function";
|
$return = "\nLet $name be a ";
|
||||||
|
$return .= $parameter_list;
|
||||||
if ($parameter_list) {
|
$return .= " $return_type.\nTo perform the function, ^L";
|
||||||
$return .= " taking $parameter_list";
|
$return .= join('', @{$item{'compound_statement(?)'}});
|
||||||
}
|
|
||||||
|
|
||||||
$return .= " and returning $return_type.\nTo perform the function, ^L";
|
|
||||||
|
|
||||||
if ($declaration_list) {
|
|
||||||
$return .= $declaration_list;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($statement_list ) {
|
|
||||||
$return .= $statement_list;
|
|
||||||
} else {
|
|
||||||
$return .= "Do nothing.\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
# $return .= "End of function $name.\n";
|
|
||||||
# $return .= $item{compound_statement};
|
|
||||||
1;
|
|
||||||
}
|
|
||||||
|
|
||||||
function_prototype:
|
|
||||||
declaration_specifiers(?) declarator[context => 'function_prototype']
|
|
||||||
'(' parameter_type_list(?) ')' ';'
|
|
||||||
{
|
|
||||||
my $declaration_specifiers = join('', @{$item{'declaration_specifiers(?)'}});
|
|
||||||
my $parameter_list = join('', @{$item{'parameter_type_list(?)'}});
|
|
||||||
|
|
||||||
my $return_type = $item{declarator};
|
|
||||||
my $name = $item{declarator};
|
|
||||||
|
|
||||||
$name =~ s/\|.*$//;
|
|
||||||
$return_type =~ s/`.*`\|?//;
|
|
||||||
|
|
||||||
if($return_type) {
|
|
||||||
$return_type .= ' ';
|
|
||||||
}
|
|
||||||
|
|
||||||
$return_type .= $declaration_specifiers;
|
|
||||||
|
|
||||||
$return = "Let $name be a function prototype";
|
|
||||||
|
|
||||||
if ($parameter_list) {
|
|
||||||
$return .= " taking $parameter_list";
|
|
||||||
}
|
|
||||||
|
|
||||||
$return .= " and returning $return_type.\n";
|
|
||||||
}
|
}
|
||||||
|
|
||||||
compound_statement:
|
compound_statement:
|
||||||
@ -230,19 +178,22 @@ compound_statement:
|
|||||||
if ($statement_list ) {
|
if ($statement_list ) {
|
||||||
$return .= $statement_list;
|
$return .= $statement_list;
|
||||||
} else {
|
} else {
|
||||||
$return .= "Do nothing and ^L";
|
$return .= "Do nothing.\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
$return .= "End block.\n" if not $arg{context};
|
$return .= "End block.\n" if not $arg{context};
|
||||||
|
|
||||||
if ($arg{context}) {
|
if ($arg{context}
|
||||||
$return .= "End $arg{context}.\n" unless $arg{context} eq 'do loop' or $arg{context} eq 'case';
|
and $arg{context} ne 'do loop'
|
||||||
|
and $arg{context} ne 'case'
|
||||||
|
and $arg{context} ne 'function definition') {
|
||||||
|
$return .= "End $arg{context}.\n";
|
||||||
}
|
}
|
||||||
1;
|
1;
|
||||||
}
|
}
|
||||||
|
|
||||||
statement_list:
|
statement_list:
|
||||||
comment(?) preproc[matchrule => 'statement'](?) statement
|
comment(?) preproc[matchrule => 'statement'](?) statement[context => undef]
|
||||||
{
|
{
|
||||||
my $preproc = join('',@{$item{'preproc(?)'}});
|
my $preproc = join('',@{$item{'preproc(?)'}});
|
||||||
my $comment = join('',@{$item{'comment(?)'}});
|
my $comment = join('',@{$item{'comment(?)'}});
|
||||||
@ -257,8 +208,7 @@ statement_list:
|
|||||||
|
|
||||||
statement:
|
statement:
|
||||||
jump_statement
|
jump_statement
|
||||||
{ $return = $item{jump_statement}; }
|
| compound_statement
|
||||||
| compound_statement[context => $arg{context}, name => $arg{context} ]
|
|
||||||
| iteration_statement
|
| iteration_statement
|
||||||
| selection_statement
|
| selection_statement
|
||||||
| labeled_statement
|
| labeled_statement
|
||||||
@ -338,7 +288,6 @@ selection_statement:
|
|||||||
| 'switch' '(' expression ')' statement[context => 'switch']
|
| 'switch' '(' expression ')' statement[context => 'switch']
|
||||||
{ $return = "Given the expression \'$item{expression}\',\n^L$item{statement}"; }
|
{ $return = "Given the expression \'$item{expression}\',\n^L$item{statement}"; }
|
||||||
|
|
||||||
|
|
||||||
jump_statement:
|
jump_statement:
|
||||||
'break' ';'
|
'break' ';'
|
||||||
{
|
{
|
||||||
@ -617,9 +566,9 @@ declaration_list:
|
|||||||
{ $return = join('', @{$item{'preproc(?)'}}) . join('', @{$item{'declaration(s)'}}); }
|
{ $return = join('', @{$item{'preproc(?)'}}) . join('', @{$item{'declaration(s)'}}); }
|
||||||
|
|
||||||
declaration:
|
declaration:
|
||||||
function_prototype
|
declaration_specifiers init_declarator_list(?) ';'
|
||||||
| declaration_specifiers init_declarator_list(?) ';'
|
|
||||||
{
|
{
|
||||||
|
print STDERR "wtf2\n", ::Dumper \%item;
|
||||||
my @init_list = defined $item{'init_declarator_list(?)'}->[0] ? @{$item{'init_declarator_list(?)'}->[0]} : ('');
|
my @init_list = defined $item{'init_declarator_list(?)'}->[0] ? @{$item{'init_declarator_list(?)'}->[0]} : ('');
|
||||||
my $init_declaration_list;
|
my $init_declaration_list;
|
||||||
|
|
||||||
@ -641,8 +590,8 @@ declaration:
|
|||||||
$inits++;
|
$inits++;
|
||||||
$return .= "Let " unless $arg{context} eq 'struct member';
|
$return .= "Let " unless $arg{context} eq 'struct member';
|
||||||
|
|
||||||
my $first_object = shift @init_list;
|
my @args = ::flatten shift @init_list;
|
||||||
my @args = split /\|/, $first_object, 3;
|
print STDERR "wtf7\n", ::Dumper \@args;
|
||||||
|
|
||||||
my ($first_qualifier, $first_initializer);
|
my ($first_qualifier, $first_initializer);
|
||||||
my $first_identifier = shift @args;
|
my $first_identifier = shift @args;
|
||||||
@ -663,19 +612,9 @@ declaration:
|
|||||||
}
|
}
|
||||||
|
|
||||||
if($first_initializer !~ /^initialized/) {
|
if($first_initializer !~ /^initialized/) {
|
||||||
if($first_qualifier =~ /\|initialized/) {
|
|
||||||
my ($fq, $fi) = split /\|/, $first_qualifier, 2;
|
|
||||||
$first_qualifier .= " $fq";
|
|
||||||
$first_initializer = $fi;
|
|
||||||
} elsif($first_initializer =~ /\|initialized/) {
|
|
||||||
my ($fq, $fi) = split /\|/, $first_initializer, 2;
|
|
||||||
$first_qualifier .= " $fq";
|
|
||||||
$first_initializer = $fi;
|
|
||||||
} else {
|
|
||||||
$first_qualifier .= " $first_initializer" if $first_initializer;
|
$first_qualifier .= " $first_initializer" if $first_initializer;
|
||||||
$first_initializer = '';
|
$first_initializer = '';
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
my @initializers;
|
my @initializers;
|
||||||
if($first_initializer) {
|
if($first_initializer) {
|
||||||
@ -683,12 +622,12 @@ declaration:
|
|||||||
}
|
}
|
||||||
|
|
||||||
for(my $i = 0; $i < @init_list; $i++) {
|
for(my $i = 0; $i < @init_list; $i++) {
|
||||||
@args = split /\|/, $init_list[$i], 3;
|
@args = ::flatten $init_list[$i];
|
||||||
|
|
||||||
my ($qualifier, $initializer);
|
my ($qualifier, $initializer);
|
||||||
my $identifier = shift @args;
|
my $identifier = shift @args;
|
||||||
$next_arg = shift @args;
|
|
||||||
|
|
||||||
|
$next_arg = shift @args;
|
||||||
if($next_arg =~ m/initialized/) {
|
if($next_arg =~ m/initialized/) {
|
||||||
$initializer = $next_arg;
|
$initializer = $next_arg;
|
||||||
$qualifier = shift @args // '';
|
$qualifier = shift @args // '';
|
||||||
@ -818,7 +757,7 @@ init_declarator:
|
|||||||
my $init = join('',@{$item[-1]});
|
my $init = join('',@{$item[-1]});
|
||||||
|
|
||||||
if (length $init) {
|
if (length $init) {
|
||||||
$return = "$item{declarator}|initialized to $init";
|
$return = [$item{declarator}, "initialized to $init"];
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -984,6 +923,7 @@ postfix_productions:
|
|||||||
}
|
}
|
||||||
| ('++')(s)
|
| ('++')(s)
|
||||||
{
|
{
|
||||||
|
print STDERR "wtf4\n", ::Dumper \%item;
|
||||||
my $increment = join('',@{$item[-1]});
|
my $increment = join('',@{$item[-1]});
|
||||||
if ($increment) {
|
if ($increment) {
|
||||||
if ($arg{context} eq 'statement') {
|
if ($arg{context} eq 'statement') {
|
||||||
@ -991,7 +931,7 @@ postfix_productions:
|
|||||||
} elsif($arg{context} eq 'struct access') {
|
} elsif($arg{context} eq 'struct access') {
|
||||||
$return = ['increment', 'by one'];
|
$return = ['increment', 'by one'];
|
||||||
} else {
|
} else {
|
||||||
$return = "$return which is incremented by one";
|
$return = "post-incremented $arg{primary_expression}";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -1004,7 +944,7 @@ postfix_productions:
|
|||||||
} elsif($arg{context} eq 'struct access') {
|
} elsif($arg{context} eq 'struct access') {
|
||||||
$return = ['decrement', 'by one'];
|
$return = ['decrement', 'by one'];
|
||||||
} else {
|
} else {
|
||||||
$return = "$return which is decremented by one";
|
$return = "post-decremented $arg{primary_expression}";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -1082,9 +1022,20 @@ primary_expression:
|
|||||||
| {} # nothing
|
| {} # nothing
|
||||||
|
|
||||||
declarator:
|
declarator:
|
||||||
direct_declarator
|
direct_declarator(s)
|
||||||
| pointer direct_declarator
|
{
|
||||||
{ $return = "$item{direct_declarator}|$item{pointer}"; }
|
my @direct_declarator = @{$item{'direct_declarator(s)'}};
|
||||||
|
if(@direct_declarator == 1) {
|
||||||
|
$return = $direct_declarator[0];
|
||||||
|
} else {
|
||||||
|
$return = $item{'direct_declarator(s)'};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
| pointer direct_declarator(s)
|
||||||
|
{
|
||||||
|
push @{$item{'direct_declarator(s)'}}, $item{pointer};
|
||||||
|
$return = $item{'direct_declarator(s)'};
|
||||||
|
}
|
||||||
|
|
||||||
direct_declarator:
|
direct_declarator:
|
||||||
identifier ':' constant
|
identifier ':' constant
|
||||||
@ -1095,13 +1046,18 @@ direct_declarator:
|
|||||||
| identifier[context => 'direct_declarator'] array_declarator(s?)
|
| identifier[context => 'direct_declarator'] array_declarator(s?)
|
||||||
{
|
{
|
||||||
if(@{$item{'array_declarator(s?)'}}) {
|
if(@{$item{'array_declarator(s?)'}}) {
|
||||||
$return = "$item{identifier}|" . join('', @{$item{'array_declarator(s?)'}});
|
$return = [$item{identifier}, join('', @{$item{'array_declarator(s?)'}})];
|
||||||
} else {
|
} else {
|
||||||
$return = "$item{identifier}";
|
$return = $item{identifier};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
| '(' declarator ')' array_declarator(s)
|
| '(' declarator ')' array_declarator(s)
|
||||||
{ $return = "$item{declarator} " . join('', @{$item{'array_declarator(s)'}}); }
|
{
|
||||||
|
push @{$item{declarator}}, join('', @{$item{'array_declarator(s)'}});
|
||||||
|
$return = $item{declarator};
|
||||||
|
}
|
||||||
|
| '(' parameter_type_list ')'
|
||||||
|
{ $return = "function taking $item{parameter_type_list} and returning"; }
|
||||||
| '(' declarator array_declarator(s) ')'
|
| '(' declarator array_declarator(s) ')'
|
||||||
{ $return = $item{'declarator'} . join('', @{$item{'array_declarator(s)'}}) }
|
{ $return = $item{'declarator'} . join('', @{$item{'array_declarator(s)'}}) }
|
||||||
| '(' declarator ')'
|
| '(' declarator ')'
|
||||||
@ -1145,37 +1101,39 @@ identifier_list:
|
|||||||
}
|
}
|
||||||
|
|
||||||
parameter_type_list:
|
parameter_type_list:
|
||||||
<skip: '[ \t]*'> parameter_list
|
parameter_list
|
||||||
| parameter_list ',' '...' # FIXME: never reached
|
|
||||||
{ $return = $item{parameter_list} . ', and possibly other arguments'; }
|
|
||||||
|
|
||||||
parameter_list:
|
parameter_list:
|
||||||
<leftop: parameter_declaration ',' parameter_declaration>
|
<leftop: parameter_declaration ',' parameter_declaration>
|
||||||
{
|
{
|
||||||
my @parameter_list = @{$item[1]};
|
my @parameter_list = @{$item[1]};
|
||||||
if ($#parameter_list > 1) {
|
my $comma = '';
|
||||||
$return = pop(@parameter_list);
|
for(my $i = 0; $i < @parameter_list; $i++) {
|
||||||
$return = join(', ', @parameter_list) . ', and ' . $return;
|
$return .= $comma;
|
||||||
} elsif ($#parameter_list == 1) {
|
if(ref $parameter_list[$i] eq 'ARRAY') {
|
||||||
$return = $parameter_list[0] . ' and ' .$parameter_list[1];
|
my @list = @{$parameter_list[$i]};
|
||||||
} else {
|
if(@list == 0) {
|
||||||
if(ref $parameter_list[0] eq 'ARRAY') {
|
|
||||||
my $list = join('', @{ $parameter_list[0] });
|
|
||||||
if(not $list) {
|
|
||||||
$return = "no parameters";
|
$return = "no parameters";
|
||||||
|
} elsif (@list == 1) {
|
||||||
|
$return .= $list[0];
|
||||||
} else {
|
} else {
|
||||||
$return = $list;
|
$return .= join(' ', @list);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
$return = $parameter_list[0];
|
$return .= $parameter_list[$i];
|
||||||
|
}
|
||||||
|
if($i == $#parameter_list - 1) {
|
||||||
|
$comma = ' and ';
|
||||||
|
} else {
|
||||||
|
$comma = ', ';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
parameter_declaration:
|
parameter_declaration:
|
||||||
declaration_specifiers declarator
|
declaration_specifiers declarator
|
||||||
{ $return = $item{declaration_specifiers} . ' ' . $item{declarator}; }
|
{ $return = [$item{declaration_specifiers}, $item{declarator}]; }
|
||||||
| /,?\.\.\./
|
| '...'
|
||||||
{ $return = "variadic parameters"; }
|
{ $return = "variadic parameters"; }
|
||||||
| declaration_specifiers abstract_declarator(?)
|
| declaration_specifiers abstract_declarator(?)
|
||||||
| ''
|
| ''
|
||||||
|
|||||||
@ -76,3 +76,7 @@ sub precompile_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(@$_) : $_ } @_
|
||||||
|
}
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user