Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[VRG]

- improved the perl parts steadily.

git-svn-id: http://svn.berlios.de/svnroot/repos/unisimu/VRG@862 625e195c-0704-0410-94f2-f261ee9f2fe7
  • Loading branch information...
commit 2b5b5720ba23dd21319ec076255368455f697206 1 parent 551ab45
agent authored
View
3  Makefile
@@ -70,8 +70,9 @@ sample/%.png: sample/%.vrg clips_all
$(vrg_run) $<
install:
- pl2bat script/xclips.pl
+ pl2bat script/xclips.pl script/clips-cover.pl
$(cp_f) script/xclips.bat $(PERL_BIN)
+ $(cp_f) script/clips-cover.bat $(PERL_BIN)
$(cp_f) lib/Clips/Batch.pm $(PERL_LIB)/Clips
$(cp_f) lib/Clips/GraphViz.pm $(PERL_LIB)/Clips
$(cp_f) lib/XClips/Compiler.pm $(PERL_LIB)/XClips
View
3  lib/Clips/GraphViz.pm
@@ -2,11 +2,11 @@ package Clips::GraphViz;
use strict;
use warnings;
-no warnings 'redefine';
use List::MoreUtils qw(any first_index);
use GraphViz;
use Data::Dump::Streamer;
+use File::Slurp;
my %NormalNodeStyle =
(
@@ -151,6 +151,7 @@ sub draw($$$) {
}
}
$gv->as_png($fname);
+ write_file("$fname.dot", $gv->as_debug);
}
sub get_facts ($$$$) {
View
2  script/vrg-run.pl
@@ -43,7 +43,7 @@
$ext = 'xclp';
}
if ($ext eq 'xclp') {
- if (system("$^X script/xclips.pl -I knowledge $infile") != 0) {
+ if (system("$^X script/xclips.pl -c -I knowledge $infile") != 0) {
die "Can't compile $infile down to CLIPS code";
}
$infile =~ s/\.xclp/.clp/i;
View
97 script/xclips.pl
@@ -15,55 +15,69 @@
'debug' => \my $debug,
) or help();
-our $infile = shift or help();
-
sub help {
die "usage: $0 [-I dir] infile\n";
}
-my $outfile;
+my @infiles = map glob, @ARGV or help();
-if ($infile !~ /\.clp$/i) {
- ($outfile = $infile) =~ s/\.xclp$/.clp/i;
- $outfile .= '.clp' if $outfile !~ /\.clp$/i;
+my @outfiles;
- our ($base) = ($outfile =~ /([\w-]+)\.\w+$/);
- $base = "f$base" if $base !~ /^[A-Za-z_]/;
+for my $infile (@infiles) {
+ compile_file($infile);
+}
- my $source = read_file($infile);
+if (!$compile_only) {
+ run_clips();
+}
- $::RD_HINT = 1;
- #$::RD_TRACE = 1;
- our $parser = XClips::Compiler->new;
- my $data = $parser->program($source);
- if (!defined $data) {
- die "abort.\n";
- }
- $data .= "\n" if $data and $data !~ /\n$/s;
- if (@::facts) {
- $data .= "(deffacts $base\n " . join("\n ", uniq @::facts). ")\n";
- }
- $data .= "\n" if $data and $data !~ /\n$/s;
+sub compile_file {
+ my $infile = shift;
+ my $outfile;
+
+ if ($infile !~ /\.clp$/i) {
+ ($outfile = $infile) =~ s/\.xclp$/.clp/i;
+ $outfile .= '.clp' if $outfile !~ /\.clp$/i;
- #my @elems = %infix_circumfix;
- #warn "\%infix_circumfix: @elems\n";
+ our ($base) = ($outfile =~ /([\w-]+)\.\w+$/);
+ $base = "f$base" if $base !~ /^[A-Za-z_]/;
- #@elems = %infix_circum_close;
- #warn "\%infix_circum_close: @elems\n";
+ my $source = read_file($infile);
- if ($data) {
- write_file($outfile, $data);
- #print $data;
+ $::RD_HINT = 1;
+ #$::RD_TRACE = 1;
+ our $parser = XClips::Compiler->new;
+ my $data = $parser->program($source);
+ if (!defined $data) {
+ die "abort.\n";
+ }
+ $data .= "\n" if $data and $data !~ /\n$/s;
+ if (@::facts) {
+ $data .= "(deffacts $base\n " . join("\n ", uniq @::facts). ")\n";
+ }
+ $data .= "\n" if $data and $data !~ /\n$/s;
+
+ #my @elems = %infix_circumfix;
+ #warn "\%infix_circumfix: @elems\n";
+
+ #@elems = %infix_circum_close;
+ #warn "\%infix_circum_close: @elems\n";
+
+ if ($data) {
+ write_file($outfile, $data);
+ #print $data;
+ }
}
-} else {
- $outfile = $infile;
+ push @outfiles, $outfile;
+ #warn "OUT: @outfiles\n";
}
-if (!$compile_only) {
+
+sub run_clips {
if ($debug) {
require Clips::Batch;
require Clips::GraphViz;
- my $clips = Clips->new($outfile);
+ my $clips = Clips::Batch->new(@outfiles);
$clips->watch('facts');
$clips->watch('rules');
$clips->reset;
@@ -72,17 +86,28 @@ sub help {
$clips->run(\my $run_log);
$clips->eof;
my $painter = Clips::GraphViz->new($init_facts, $run_log);
- $outfile =~ s/\.clp$/\.png/i;
+ my $outfile = 'a.png';
$painter->draw(
outfile => $outfile,
trim => $trim,
);
warn "generating $outfile...\n";
+
+ require YAML::Syck;
+ my $db_dir = 'clips_cover_db';
+ mkdir $db_dir if !-d $db_dir;
+ my ($fname, $time);
+ $time = time;
+ while (my $rand = int rand 1000000) {
+ $fname = "$db_dir/$time-$rand.yml";
+ last if !-e $fname;
+ }
+ YAML::Syck::DumpFile($fname, [$rules, $run_log]);
} else {
require Clips::Batch;
- my $clips = Clips->new($outfile);
+ my $clips = Clips::Batch->new(@outfiles);
$clips->reset;
- $clips->run(sub { print $_[0] } );
+ $clips->run(sub { print $_[0] if defined $_[0] });
$clips->eof;
}
-}
+}
Please sign in to comment.
Something went wrong with that request. Please try again.