From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 5 Mar 2016 07:36:37 +0000 (+0000)
Subject: searchstate setup, introduce qvars diagnostic
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=384a5e930c104f88e4235e8b89106425f2725f90;p=scpubgit%2FDX.git

searchstate setup, introduce qvars diagnostic
---

diff --git a/lib/DX/Proposition.pm b/lib/DX/Proposition.pm
index 56d1d2a..154557a 100644
--- a/lib/DX/Proposition.pm
+++ b/lib/DX/Proposition.pm
@@ -1,14 +1,15 @@
 package DX::Proposition;
 
+use Types::Standard qw(HashRef ArrayRef Str);
 use DX::Class;
 
-has predicate => (is => 'ro', required => 1);
+has predicate => (is => 'ro', isa => Str, required => 1);
 
-has args => (is => 'ro', required => 1);
+has args => (is => 'ro', isa => ArrayRef, required => 1);
 
-has introduces_names => (is => 'ro', required => 1);
+has introduces_names => (is => 'ro', isa => HashRef, required => 1);
 
-has requires_names => (is => 'ro', required => 1);
+has requires_names => (is => 'ro', isa => HashRef, required => 1);
 
 sub resolve_for {
   my ($self, $scope) = @_;
diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index 857745d..68f4638 100644
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -1,6 +1,14 @@
 package DX::QueryState;
 
 use Types::Standard qw(HashRef);
+use DX::Scope;
+use DX::Hypothesis;
+use DX::SearchState;
+use DX::ResolvedPropositionSet;
+use DX::Value::Unset;
+use DX::ActionBuilder::UnsetValue;
+use DX::ActionPolicy::Allow;
+use DX::Utils qw(:builders);
 use DX::Class;
 
 has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);
@@ -11,4 +19,52 @@ has proposition_sequence => (
   is => 'ro', isa => PropositionSequence, required => 1
 );
 
+has search_state => (
+  is => 'lazy', builder => sub {
+    $_[0]->new_search_state_for($_[0]->proposition_sequence)
+  },
+);
+
+sub new_search_state_for {
+  my ($self, $prop_seq) = @_;
+  my @local_names = map { keys %{$_->introduces_names} }
+                      @{$prop_seq->members};
+  my $scope = DX::Scope->new(
+    predicates => $self->predicates,
+    globals => $self->globals,
+    locals => [
+      dict(
+        map +($_ => DX::Value::Unset->new(
+                      identity_path => [ 0, $_ ],
+                      action_builder => DX::ActionBuilder::UnsetValue->new(
+                        target_path => [ 0, $_ ],
+                      )
+                    )
+        ), @local_names
+      )
+    ]
+  );
+  my $hyp = DX::Hypothesis->new(
+    scope => $scope,
+    resolved_propositions => DX::ResolvedPropositionSet->new_empty,
+    outstanding_propositions => $prop_seq->members,
+    actions => [],
+    action_policy => DX::ActionPolicy::Allow->new,
+  );
+  return DX::SearchState->new(
+    current_hypothesis => $hyp,
+    alternatives => [],
+  );
+}
+
+sub with_additional_proposition {
+  my ($self, $prop) = @_;
+  my $prop_seq = $self->proposition_sequence
+                      ->but_append_proposition($prop);
+  $self->but(
+    proposition_sequence => $prop_seq,
+    search_state => $self->new_search_state_for($prop_seq)
+  );
+}
+
 1;
diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index 5fc19e1..2fb604c 100644
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -19,13 +19,15 @@ has tcl => (is => 'lazy', builder => sub {
   weaken $self;
   my $tcl = Tcl->new;
   $tcl->CreateCommand('?' => sub {
-    $self->apply_to_state([ 'new_query_state' ], [ mode => 'query' ])
+    $self->apply_to_state([ 'new_query_state' ], [ mode => 'query' ]);
   });
   $tcl->CreateCommand('?+' => sub {
-    $self->apply_to_state([ mode => 'query' ])
+    $self->apply_to_state([ mode => 'query' ]);
   });
+  my $qvars;
   $tcl->CreateCommand('.' => sub {
-    $self->apply_to_state([ mode => 'shell' ])
+    $self->apply_to_state([ mode => 'shell' ]);
+    $qvars->();
   });
   $tcl->CreateCommand(qlist => sub {
     push our @Result, map [ output => $_ ], @{
@@ -33,6 +35,12 @@ has tcl => (is => 'lazy', builder => sub {
     };
     return;
   });
+  $tcl->CreateCommand(qvars => $qvars = sub {
+    my $locals = $self->shell_state->current_query_state->search_state
+                      ->current_hypothesis->scope->locals->[0];
+    push our @Result, [ output => $locals ];
+    return;
+  });
   foreach my $pred (
     keys %{$self->shell_state->template_query_state->predicates}
   ) {
@@ -82,7 +90,7 @@ sub apply_predicate {
   die "Can't call predicate ${pred} outside a query\n"
     unless $self->shell_state->mode eq 'query';
   my @args = $self->expand_args(@arg_strings);
-  my $intro; my $need;
+  my ($intro, $need) = ({}, {});
   foreach my $arg (@args) {
     next if ref($arg);
     # ?Foo is intro, Foo is need
@@ -95,10 +103,7 @@ sub apply_predicate {
     requires_names => $need,
   );
   my $qstate = $self->shell_state->current_query_state;
-  $qstate = $qstate->but(
-    proposition_sequence => $qstate->proposition_sequence
-                                   ->but_append_proposition($prop)
-  );
+  $qstate = $qstate->with_additional_proposition($prop);
   $self->_set_shell_state(
     $self->shell_state->but(
       current_query_state => $qstate
diff --git a/lib/DX/ShellState.pm b/lib/DX/ShellState.pm
index 665d9bc..52a6731 100644
--- a/lib/DX/ShellState.pm
+++ b/lib/DX/ShellState.pm
@@ -7,7 +7,7 @@ has template_query_state => (
 );
 
 has current_query_state => (
-  is => 'ro', predicate => 1, isa => QueryState
+  is => 'lazy', builder => 'new_query_state'
 );
 
 has mode => (is => 'ro', required => 1);