From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 22 Feb 2014 05:48:50 +0000 (+0000)
Subject: eliminate variable name requirement from query()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDKit.git;a=commitdiff_plain;h=7d384ecaab6d7440b19924dd45040a01345b4392

eliminate variable name requirement from query()
---

diff --git a/bin/dx-shell b/bin/dx-shell
index 6848ed6..1865982 100644
--- a/bin/dx-shell
+++ b/bin/dx-shell
@@ -47,8 +47,8 @@ sub expand_body {
 }
 
 $tcl->CreateCommand(query => sub {
-  my (undef, undef, undef, $vars, $body) = @_;
-  @last_q = expand_def($vars, $body);
+  my (undef, undef, undef, $body) = @_;
+  @last_q = expand_body($body);
   do_query();
   return;
 });
@@ -92,12 +92,6 @@ foreach my $rule (keys %{$solver->rule_set->rules}) {
   $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->CreateCommand(foreach => sub {
   my (undef, undef, undef, $var, $body, $each_body) = @_;
   push our @Body_Parts, [
diff --git a/lib/DX/Op/FindAll.pm b/lib/DX/Op/FindAll.pm
index f8770fb..ff22ce4 100644
--- a/lib/DX/Op/FindAll.pm
+++ b/lib/DX/Op/FindAll.pm
@@ -17,7 +17,7 @@ sub make_result_handler {
   DX::Op::FromCode->new(
     code => sub {
       my ($self, $state) = @_;
-      $state->bind_value($state->scope->{$coll_name} => $coll)
+      $state->assign_vars($coll_name => { bound_value => $coll })
             ->then($self->next);
     },
     next => $self->next
diff --git a/lib/DX/Op/Materialize.pm b/lib/DX/Op/Materialize.pm
index ee17e55..b9814fd 100644
--- a/lib/DX/Op/Materialize.pm
+++ b/lib/DX/Op/Materialize.pm
@@ -4,15 +4,13 @@ use Moo;
 
 with 'DX::Role::Op';
 
-has var_name => (is => 'ro', required => 1);
-
 sub run {
   my ($self, $state) = @_;
-  my $var = $state->scope_var($self->var_name);
-  unless ($var->is_bound) {
-    die "Can't materialize unbound ".$self->var_name;
+  foreach my $k (keys %{$state->scope}) {
+    my $var = $state->scope_var($k);
+    next unless $var->is_bound;
+    $state->resolve_value($var);
   }
-  $state->resolve_value($var);
   $state->then($self->next);
 }
 
diff --git a/lib/DX/Result.pm b/lib/DX/Result.pm
index d409b55..3740cc7 100644
--- a/lib/DX/Result.pm
+++ b/lib/DX/Result.pm
@@ -6,7 +6,8 @@ use Moo;
 has _state => (is => 'ro', required => 1, init_arg => 'state');
 
 sub var_names {
-  sort keys %{$_[0]->_state->scope};
+  grep $_[0]->_state->scope_var($_)->is_bound,
+    sort keys %{$_[0]->_state->scope};
 }
 
 sub actions {
diff --git a/lib/DX/RuleSet.pm b/lib/DX/RuleSet.pm
index 9449f92..f0ee6ed 100644
--- a/lib/DX/RuleSet.pm
+++ b/lib/DX/RuleSet.pm
@@ -139,8 +139,8 @@ sub _expand_op_react {
 }
 
 sub _expand_op_materialize {
-  my ($self, $var_name) = @_;
-  DX::Op::Materialize->new(var_name => $var_name);
+  my ($self) = @_;
+  DX::Op::Materialize->new;
 }
 
 sub _expand_op_prop {
diff --git a/lib/DX/Solver.pm b/lib/DX/Solver.pm
index 6626840..6300b23 100644
--- a/lib/DX/Solver.pm
+++ b/lib/DX/Solver.pm
@@ -19,10 +19,9 @@ has facts => (is => 'ro', default => sub { {} });
 has observation_policy => (is => 'ro');
 
 sub query {
-  my ($self, $vars, @terms) = @_;
+  my ($self, @terms) = @_;
   my $rule_set = $self->rule_set;
-  push @terms, map +[ materialize => $_ ], @$vars;
-  my $head = $rule_set->expand_and_link(undef, @terms);
+  my $head = $rule_set->expand_and_link(undef, @terms, [ 'materialize' ]);
   my $state = DX::State->new(
     next_op => $head,
     return_stack => [],
@@ -31,7 +30,7 @@ sub query {
     last_choice => [],
     facts => $self->facts,
     rule_set => $rule_set,
-  )->assign_vars(map +($_ => {}), @$vars);
+  );
   return DX::ResultStream->new(
     for_state => $state,
     ($self->observation_policy
diff --git a/t/basic_rule.t b/t/basic_rule.t
index 95d2666..1922d7e 100644
--- a/t/basic_rule.t
+++ b/t/basic_rule.t
@@ -45,7 +45,7 @@ $solver->add_rule(
   server => [ 'S' ] => [ member_of => S => [ value => 'servers' ] ]
 );
 
-my $s = $solver->query([ 'S' ], [ server => 'S' ]);
+my $s = $solver->query([ server => 'S' ]);
 
 is_deeply([ map $_->value_for('S')->{name}, $s->results ], [ sort @servers ]);
 
@@ -61,7 +61,6 @@ $solver->add_rule(
                  );
 
 $s = $solver->query(
-       [ qw(Shell Srv) ],
        [ shell => 'Shell' ],
        [ name => 'Shell', [ value => 'bash' ] ],
        [ server => 'Srv' ],
diff --git a/t/dot_ssh.t b/t/dot_ssh.t
index 9619022..aac7c71 100644
--- a/t/dot_ssh.t
+++ b/t/dot_ssh.t
@@ -83,7 +83,7 @@ $solver->add_rule(@$_) for (
 
 sub paths_for_simple {
   join ' ', map $_->value_for('PS')->path, $solver->query(
-    [ qw(PS) ], [ path_status => 'PS' ], @_
+    [ path_status => 'PS' ], @_
   )->results;
 }
 
@@ -107,8 +107,7 @@ $solver->add_rule(
 
 throws_ok {
   $solver->query(
-    [ qw(PS) ],
-      [ path_status_at => 'PS', [ value => '.ssh' ] ]
+    [ path_status_at => 'PS', [ value => '.ssh' ] ]
   )->results
 } qr/ARGH/;
 
@@ -129,8 +128,7 @@ my @res;
 
 lives_ok {
   @res = $solver->query(
-    [ qw(PS) ],
-      [ path_status_at => 'PS', [ value => '.ssh' ] ]
+    [ path_status_at => 'PS', [ value => '.ssh' ] ]
   )->results
 };
 
@@ -166,7 +164,7 @@ $solver->add_rule(
 $ob_res{'.ssh'} = $protos{'.ssh'};
 
 sub paths_for {
-  join ' ', map $_->value_for('PS')->path, $solver->query([ 'PS' ], @_)->results;
+  join ' ', map $_->value_for('PS')->path, $solver->query(@_)->results;
 }
 
 is(
@@ -219,7 +217,7 @@ $ob_res{'.ssh'} = $empty{'.ssh'};
 $solver->{observation_policy} = sub { 1 };
 
 sub dot_ssh_query {
-  $solver->query([ 'PS' ], [ directory_at => 'PS' => [ value => '.ssh' ] ]);
+  $solver->query([ directory_at => 'PS' => [ value => '.ssh' ] ]);
 }
 
 is_deeply(
@@ -315,7 +313,7 @@ $solver->add_rule(@$_) for (
 %ob_res = %empty;
 
 sub keys_file {
-  $solver->query([ qw(D F) ],
+  $solver->query(
      [ directory_at => 'D' => \'.ssh' ],
      [ file_in => 'D' => \'authorized_keys' => 'F' ],
    );
diff --git a/t/findall.t b/t/findall.t
index df84bfe..47fee23 100644
--- a/t/findall.t
+++ b/t/findall.t
@@ -28,15 +28,13 @@ $solver->facts->{shell_installed} = DX::OrderedSet->new(
 );
 
 $solver->add_rule(has_shell => [ 'Srv', 'Shell' ],
-  [ exists => [ qw(Name SI) ] =>
-    [ member_of => 'SI', \'shell_installed' ],
-    [ prop => 'SI' => \'server' => 'Name' ],
-    [ prop => 'Srv' => \'name' => 'Name' ],
-    [ prop => 'SI' => \'shell' => 'Shell' ]
-  ],
+  [ member_of => 'SI', \'shell_installed' ],
+  [ prop => 'SI' => \'server' => 'Name' ],
+  [ prop => 'Srv' => \'name' => 'Name' ],
+  [ prop => 'SI' => \'shell' => 'Shell' ]
 );
 
-my @r = $solver->query([ 'X' ],
+my @r = $solver->query(
   [ findall => X => S =>
     [ member_of => 'S', \'server' ],
     [ has_shell => 'S', \'bash' ],
@@ -48,7 +46,7 @@ is_deeply(
   [ qw(one three four) ]
 );
 
-@r = $solver->query([],
+@r = $solver->query(
   [ foreach => S => [ [ member_of => 'S', \'server' ] ],
     [ [ has_shell => 'S' => \'bash' ] ] ]
 )->results;
@@ -58,7 +56,7 @@ ok(!@r, 'No results for only bash');
 $solver->add_rule(has_any_shell => [ 'S' ] => [ has_shell => 'S' => \'bash' ]);
 $solver->add_rule(has_any_shell => [ 'S' ] => [ has_shell => 'S' => \'csh' ]);
 
-@r = $solver->query([],
+@r = $solver->query(
   [ foreach => S => [ [ member_of => 'S', \'server' ] ],
     [ [ has_any_shell => 'S' ] ] ]
 )->results;