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