mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-19 10:29:30 +01:00
Rough-draft work-in-progress alpha of new C-to-English module
This commit is contained in:
parent
6740522fae
commit
730120be36
@ -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 => 616,
|
BUILD_REVISION => 617,
|
||||||
BUILD_DATE => "2014-06-05",
|
BUILD_DATE => "2014-06-07",
|
||||||
};
|
};
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
@ -17,12 +17,15 @@ $code =~ s/#include <([^>]+)>/\n#include <$1>\n/g;
|
|||||||
$code =~ s/#([^ ]+) (.*?)\\n/\n#$1 $2\n/g;
|
$code =~ s/#([^ ]+) (.*?)\\n/\n#$1 $2\n/g;
|
||||||
$code =~ s/#([\w\d_]+)\\n/\n#$1\n/g;
|
$code =~ s/#([\w\d_]+)\\n/\n#$1\n/g;
|
||||||
|
|
||||||
|
my $original_code = $code;
|
||||||
|
|
||||||
my $precode = $code;
|
my $precode = $code;
|
||||||
$code = '';
|
$code = '';
|
||||||
|
|
||||||
my $has_main = 0;
|
my ($has_function, $has_main);
|
||||||
|
|
||||||
my $prelude = "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <errno.h>\n#include <ctype.h>\n#include <assert.h>\n#include <prelude.h>\n\n";
|
my $prelude_base = "#define _XOPEN_SOURCE 9001\n#define __USE_XOPEN\n#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n#include <errno.h>\n#include <ctype.h>\n#include <assert.h>\n\n";
|
||||||
|
my $prelude = $prelude_base;
|
||||||
$prelude .= "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s;
|
$prelude .= "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s;
|
||||||
|
|
||||||
my $preprecode = $precode;
|
my $preprecode = $precode;
|
||||||
@ -51,6 +54,7 @@ while($preprecode =~ s/([ a-zA-Z0-9\_\*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*
|
|||||||
$precode .= $extract[1];
|
$precode .= $extract[1];
|
||||||
}
|
}
|
||||||
$code .= "$ret $ident($params) $body\n\n";
|
$code .= "$ret $ident($params) $body\n\n";
|
||||||
|
$has_function = 1;
|
||||||
$has_main = 1 if $ident eq 'main';
|
$has_main = 1 if $ident eq 'main';
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -58,7 +62,7 @@ $precode =~ s/^\s+//;
|
|||||||
$precode =~ s/\s+$//;
|
$precode =~ s/\s+$//;
|
||||||
|
|
||||||
if(not $has_main) {
|
if(not $has_main) {
|
||||||
$code = "$prelude\n\n$code\n\nint main(void) { $precode\n;\nreturn 0;}\n";
|
$code = "$prelude\n\n$code\n\nint main(void) {\n$precode\n;\nreturn 0;}\n";
|
||||||
} else {
|
} else {
|
||||||
$code = "$prelude\n\n$precode\n\n$code\n";
|
$code = "$prelude\n\n$precode\n\n$code\n";
|
||||||
}
|
}
|
||||||
@ -71,13 +75,13 @@ $code =~ s/;(\s*\/\*.*?\*\/\s*);\n/;$1/gs;
|
|||||||
$code =~ s/;(\s*\/\/.*?\s*);\n/;$1/gs;
|
$code =~ s/;(\s*\/\/.*?\s*);\n/;$1/gs;
|
||||||
$code =~ s/({|})\n\s*;\n/$1\n/gs;
|
$code =~ s/({|})\n\s*;\n/$1\n/gs;
|
||||||
|
|
||||||
chdir "$ENV{HOME}/blackshell/msmud/babel-buster/code" or die "Could not chdir: $!";
|
chdir "c2english" or die "Could not chdir: $!";
|
||||||
|
|
||||||
open my $fh, '>', 'code.c' or die "Could not write code: $!";
|
open my $fh, '>', 'code.c' or die "Could not write code: $!";
|
||||||
print $fh $code;
|
print $fh $code;
|
||||||
close $fh;
|
close $fh;
|
||||||
|
|
||||||
my ($ret, $result) = execute(10, "gcc -std=c89 -pedantic -Werror -Wno-unused -fsyntax-only -fno-diagnostics-show-option code.c");
|
my ($ret, $result) = execute(10, "gcc -std=c89 -pedantic -Werror -Wno-unused -fsyntax-only -fno-diagnostics-show-option -fno-diagnostics-show-caret code.c");
|
||||||
|
|
||||||
if(not $force and $ret != 0) {
|
if(not $force and $ret != 0) {
|
||||||
$output = $result;
|
$output = $result;
|
||||||
@ -149,37 +153,28 @@ if(not $force and $ret != 0) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
$output = `./c2e 2>/dev/null code.c` if not defined $output;
|
$code =~ s/^\Q$prelude_base\E\s*//;
|
||||||
|
|
||||||
if(not $has_main) {
|
open my $fh, '>', 'code2eng.c' or die "Could not write code: $!";
|
||||||
$output =~ s/Let main be a function returning an integer. It is called with no arguments. To perform the function, //;
|
print $fh $code;
|
||||||
$output =~ s/\s*(Then|Next,|Continuing on, we next)?\s*return 0.//i;
|
close $fh;
|
||||||
$output =~ s/^(.)/uc $1/e;
|
|
||||||
|
$output = `./c2eng.pl code2eng.c` if not defined $output;
|
||||||
|
|
||||||
|
if(not $has_function and not $has_main) {
|
||||||
|
$output =~ s/Let 'main' be a function taking no parameters and returning int.\s*To perform the function:\s*//;
|
||||||
|
$output =~ s/\s*Return 0.\s*$//;
|
||||||
|
$output =~ s/\s*Return 0.\s*End of function 'main'.\s*//;
|
||||||
|
$output =~ s/\s*Do nothing.\s*$//;
|
||||||
|
$output =~ s/^\s*(.)/\U$1/;
|
||||||
}
|
}
|
||||||
|
|
||||||
$output =~ s/"a"/a/g;
|
|
||||||
$output =~ s/whose initial value is/with value being/g;
|
|
||||||
$output =~ s/each element of which is a(n?)/of type a$1/g;
|
|
||||||
$output =~ s/\s+s\s*$//g;
|
|
||||||
$output =~ s/variable/object/g;
|
|
||||||
$output =~ s/of type a pointer/of type pointer/g;
|
|
||||||
$output =~ s/of type a character/of type char/g;
|
|
||||||
$output =~ s/of type an integer/of type int/g;
|
|
||||||
$output =~ s/to a character/to char/g;
|
|
||||||
$output =~ s/to an integer/to int/g;
|
|
||||||
$output =~ s/with no arguments returning/with unspecified arguments returning/g;
|
|
||||||
$output =~ s/with argument a void/with no arguments/g;
|
|
||||||
$output =~ s/\s*After that,\s*$//;
|
|
||||||
$output =~ s/as long as zero does not equal 1/while the condition is true/g;
|
|
||||||
$output =~ s/\ncompute nothing.//g;
|
|
||||||
|
|
||||||
$output =~ s/\s+/ /;
|
$output =~ s/\s+/ /;
|
||||||
if($output eq " ") {
|
if(not $output) {
|
||||||
print "Does not compute. I only know about C89 and valid code.\n";
|
$output = "Does not compute. I only know about C89 and valid code.\n";
|
||||||
exit;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
print "$output\n";
|
print "[Note: Work-in-progress; may be issues!] $output\n";
|
||||||
|
|
||||||
sub execute {
|
sub execute {
|
||||||
my $timeout = shift @_;
|
my $timeout = shift @_;
|
||||||
|
1231
modules/c2english/CGrammar.pm
Normal file
1231
modules/c2english/CGrammar.pm
Normal file
File diff suppressed because it is too large
Load Diff
66
modules/c2english/c2eng.pl
Executable file
66
modules/c2english/c2eng.pl
Executable file
@ -0,0 +1,66 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use Parse::RecDescent;
|
||||||
|
use Getopt::Std;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
# todo: 1. the entire syntax for pointers to functions.
|
||||||
|
# 2. preprocessor directives. (getting there)
|
||||||
|
# So, the problem with handling CPP directives is when they
|
||||||
|
# interrupt something. I'm open to ideas.
|
||||||
|
# 4. functions to handle the nesting levels (ordinal number generator and CPP stack)
|
||||||
|
# 6. change returns to prints where appropriate.
|
||||||
|
|
||||||
|
open GRAMMAR, 'CGrammar.pm' or die "Could not open CGrammar.pm: $!";
|
||||||
|
local $/;
|
||||||
|
my $grammar = <GRAMMAR>;
|
||||||
|
close GRAMMAR;
|
||||||
|
|
||||||
|
our ($opt_T, $opt_t, $opt_o);
|
||||||
|
getopts('Tto:');
|
||||||
|
|
||||||
|
if ($opt_T ) {
|
||||||
|
$::RD_TRACE = 1;
|
||||||
|
} else {
|
||||||
|
undef $::RD_TRACE ;
|
||||||
|
}
|
||||||
|
|
||||||
|
$::RD_HINT = 1;
|
||||||
|
$Parse::RecDescent::skip = '\s*';
|
||||||
|
|
||||||
|
# This may be necessary..
|
||||||
|
# $::RD_AUTOACTION = q { [@item] };
|
||||||
|
|
||||||
|
my $parser = Parse::RecDescent->new($grammar) 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
defined $parser->startrule(\$text) or die "Bad text!\n$text\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
$text =~ s/\s+//g;
|
||||||
|
print "\n[$text]\n" if length $text;
|
Loading…
Reference in New Issue
Block a user