lib/DX/Step/ConsiderProposition.pm

   1 package DX::Step::ConsiderProposition;
   2
   3 use DX::Value::Unset;
   4 use DX::ActionBuilder::UnsetValue;
   5 use DX::Class;
   6
   7 with 'DX::Role::Step';
   8
   9 has proposition => (is => 'ro', isa => Proposition, required => 1);
  10
  11 sub apply_to {
  12   my ($self, $ss) = @_;
  13   my $hyp = $ss->current_hypothesis;
  14   trace consider => [
  15     statement => [
  16       [ symbol => 'consider' ],
  17       @{$self->proposition->for_deparse->[1]},
  18     ],
  19   ];
  20   my $old_scope = (my $old_hyp = $ss->current_hypothesis)->scope;
  21   my @old_locals = @{$old_scope->locals};
  22   my $top_level = $#old_locals;
  23   my $top = pop @old_locals;
  24   my $top_members = $top->members;
  25   my @new_names = grep !exists $top_members->{$_},
  26                     keys %{$self->proposition->introduced_names};
  27   my $new_scope = $old_scope->but(
  28     locals => [
  29       @old_locals,
  30       $top->but(members => {
  31         %{$top_members},
  32         map +($_ => DX::Value::Unset->new(
  33                       action_builder => DX::ActionBuilder::UnsetValue->new(
  34                         target_path => [ $top_level, $_ ],
  35                       )
  36                     )
  37         ), @new_names
  38       }),
  39     ],
  40     lex_map => {
  41       %{$old_scope->lex_map},
  42       map +($_ => [ $top_level, $_ ]), @new_names
  43     }
  44   );
  45   my $new_hyp = $old_hyp->but(scope => $new_scope);
  46   return $ss->but(
  47     current_hypothesis => $new_hyp,
  48     next_step => $self->proposition->resolve_for($new_scope)
  49   );
  50 }
  51
  52 1;