From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 14 Feb 2014 08:33:40 +0000 (+0000)
Subject: add rule and exists built-ins to shell
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a26f6378633c0cc46a9573e42764a3ec084d1972;p=scpubgit%2FDKit.git

add rule and exists built-ins to shell
---

diff --git a/bin/dx-shell b/bin/dx-shell
index 20a5b6b..b320133 100644
--- a/bin/dx-shell
+++ b/bin/dx-shell
@@ -5,6 +5,7 @@ use curry;
 use DX::Solver;
 use DX::Lib::FS;
 use Term::ReadLine;
+use Devel::Dwarn;
 
 my $solver = DX::Solver->new(observation_policy => sub { 1 });
 
@@ -31,12 +32,17 @@ sub do_query {
   } @res ]);
 }
 
-$tcl->CreateCommand(query => sub {
-  my (undef, undef, undef, $vars, $body) = @_;
+sub expand_def {
+  my ($vars, $body) = @_;
   my @varnames = $split->($vars);
   local our @Body_Parts;
   $tcl->Eval($body);
-  @last_q = (\@varnames, @Body_Parts);
+  return (\@varnames, @Body_Parts);
+}
+
+$tcl->CreateCommand(query => sub {
+  my (undef, undef, undef, $vars, $body) = @_;
+  @last_q = expand_def($vars, $body);
   do_query();
   return;
 });
@@ -62,13 +68,30 @@ my $rule_sub = sub {
   return;
 };
 
+$tcl->CreateCommand(rule => sub {
+  my (undef, undef, undef, $rule, $vars, $body) = @_;
+  $solver->add_rule($rule => expand_def($vars, $body));
+  $tcl->CreateCommand($rule => $rule_sub);
+  return;
+});
+
 foreach my $rule (keys %{$solver->rule_set->rules}) {
   $rule =~ s/\/\d+$//;
   $tcl->CreateCommand($rule => $rule_sub);
 }
+
+$tcl->CreateCommand(exists => sub {
+  my (undef, undef, undef, $vars, $body) = @_;
+  push our @Body_Parts, [ exists => expand_def($vars, $body) ];
+  return;
+});
   
 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});
 
+if ($ARGV[0]) {
+  $tcl->EvalFile($ARGV[0]);
+}
+
 my $rl = Term::ReadLine->new;
 
 my $cmd;