eliminate outstanding_propositions attribute

[scpubgit/DX.git] / lib / DX / ShellSession.pm

diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index 13ebf78..eae1349 100644 (file)
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -4,6 +4,8 @@ use Tcl;
 use Scalar::Util qw(weaken);
 use DX::Expander;
 use DX::Proposition;
+use DX::ActionBuilder::Normal;
+use DX::RuleDefinitionContext;
 use DX::Utils qw(deparse);
 use DX::Class;
 
@@ -29,6 +31,24 @@ has tcl => (is => 'lazy', builder => sub {
     $self->apply_to_state([ mode => 'shell' ]);
     $qvars->();
   });
+  $tcl->CreateCommand('...' => sub {
+    $self->apply_to_state([ mode => 'shell' ]);
+    my $orig = my $cur = $self->shell_state->current_query_state;
+    while ($cur) {
+      $self->_set_shell_state(
+        $self->shell_state->but(current_query_state => $cur)
+      );
+      $qvars->();
+      $cur = eval { $cur->with_forced_backtrack };
+      push our @Result, [ output => $@ ] if $@;
+    }
+    $self->_set_shell_state(
+      $self->shell_state->but(
+        current_query_state => $orig
+      ),
+    );
+    return;
+  });
   $tcl->CreateCommand(qlist => sub {
     push our @Result, map [ output => $_ ], @{
       $self->shell_state->current_query_state->proposition_sequence->members
@@ -47,14 +67,83 @@ has tcl => (is => 'lazy', builder => sub {
     push our @Result, [ output => $rps ];
     return;
   });
+  $tcl->CreateCommand(qact => sub {
+    my $act = $self->shell_state->current_query_state->search_state
+                   ->current_hypothesis->actions;
+    push our @Result, map [ output => $_ ], @$act;
+    return;
+  });
   foreach my $pred (
     keys %{$self->shell_state->template_query_state->predicates}
   ) {
     $tcl->CreateCommand($pred => sub {
       my (undef, undef, undef, @args) = @_; # ($data, $interp, $pred)
-      $self->apply_predicate($pred => @args);
+      (our $Shell_Context)->apply_predicate($pred => @args);
     });
   }
+  $tcl->CreateCommand(const => sub {
+    my (undef, undef, undef, $name, $value) = @_;
+    my $tqs = $self->shell_state->template_query_state;
+    my $new_tqs = $tqs->but(
+      globals => $tqs->globals->with_member_at(
+        $name => DX::ActionBuilder::Null->new(
+                   target_path => [ $name ],
+                 )->apply_to_value($self->expand_args($value)),
+      ),
+    );
+    $self->_set_shell_state(
+      $self->shell_state->but(
+        template_query_state => $new_tqs
+      ),
+    );
+  });
+  $tcl->CreateCommand(state => sub {
+    my (undef, undef, undef, $name, $value) = @_;
+    my $tqs = $self->shell_state->template_query_state;
+    my $new_tqs = $tqs->but(
+      globals => $tqs->globals->with_member_at(
+        $name => DX::ActionBuilder::Normal->new(
+                   target_path => [ $name ],
+                 )->apply_to_value($self->expand_args($value)),
+      ),
+    );
+    $self->_set_shell_state(
+      $self->shell_state->but(
+        template_query_state => $new_tqs
+      ),
+    );
+  });
+  $tcl->CreateCommand(trace => sub {
+    my (undef, undef, undef, @trace) = @_;
+    $self->_set_shell_state(
+      $self->shell_state->with_trace_changes(@trace)
+    );
+  });
+  $tcl->CreateCommand(rule => sub {
+    my (undef, undef, undef, $pred, $args, $body) = @_;
+    local our $Shell_Context = DX::RuleDefinitionContext->new(
+                                 arg_names => [ $self->tcl->SplitList($args) ],
+                                 expander => $self->expander,
+                               );
+    $self->tcl->Eval($body);
+    my $rule = $Shell_Context->bake_rule;
+    my $tqs = $self->shell_state->template_query_state;
+    my $new_tqs = $tqs->but(
+      predicates => {
+        %{$tqs->predicates},
+        $pred => $rule,
+      },
+    );
+    $self->_set_shell_state(
+      $self->shell_state->but(
+        template_query_state => $new_tqs
+      ),
+    );
+    $self->tcl->CreateCommand($pred => sub {
+      my (undef, undef, undef, @args) = @_; # ($data, $interp, $pred)
+      (our $Shell_Context)->apply_predicate($pred => @args);
+    });
+  });
   return $tcl;
 });
 
@@ -80,6 +169,9 @@ sub eval_command_string {
   my ($self, $string) = @_;
   local our @Result;
   try {
+    no warnings 'redefine';
+    local *DX::Utils::trace = $self->shell_state->trace_sub;
+    local our $Shell_Context = $self;
     $self->tcl->Eval($string);
   } catch {
     push @Result, [ output => $_ ];
@@ -99,23 +191,27 @@ sub apply_predicate {
   my ($intro, $need) = ({}, {});
   foreach my $arg (@args) {
     next if ref($arg);
+    next if $arg =~ /^\??[a-z]/; # skip globals
     # ?Foo is intro, Foo is need
     ($arg =~ s/^\?// ? $intro : $need)->{$arg} = 1;
   }
   my $prop = DX::Proposition->new(
     predicate => $pred,
     args => \@args,
-    introduces_names => $intro,
-    requires_names => $need,
+    introduced_names => $intro,
+    required_names => $need,
   );
   my $old_qstate = $self->shell_state->current_query_state;
   my $qstate = $old_qstate->with_additional_proposition($prop);
-  my $old_action_count = @{
-    $old_qstate->search_state->current_hypothesis->actions
+  my $old_application_count = @{
+    $old_qstate->search_state->current_hypothesis->action_applications
+  };
+  my @applications = @{
+    $qstate->search_state->current_hypothesis->action_applications
   };
-  my @actions = @{$qstate->search_state->current_hypothesis->actions};
   push our @Result,
-    map [ output => $_ ], @actions[$old_action_count..$#actions];
+    map [ output => $_ ],
+      @applications[$old_application_count..$#applications];
   $self->_set_shell_state(
     $self->shell_state->but(
       current_query_state => $qstate