13 my $solver = DX::Solver->new(observation_policy => sub { 1 });
15 DX::Lib::FS->new->load_into($solver);
18 # [ $solver->query([ 'D' ], [ directory_at => 'D' => \'t' ])->results ]
19 # ->[0]->value_for('D')
26 my $split = $tcl->curry::weak::SplitList;
28 my ($r, $res, @last_q);
33 $r = ($res->isa('DX::Result') ? $res : $res->next);
34 unless ($r) { warn "false\n"; return; }
35 if (my @act = $r->actions) {
36 warn YAML::Dump([ map $_->as_structure, @act ]);
38 my $values = $r->all_values;
39 unless (keys %$values) {
40 warn "---\ntrue\n"; return;
43 map +($_ => ($values->{$_}->$_does('DX::Role::Set')
44 ? [ $values->{$_}->all ]
51 $res = $solver->$last_mode(@last_q);
56 my ($vars, $body) = @_;
57 my @varnames = $split->($vars);
58 return (\@varnames, expand_body($body));
63 die "No body!" unless $body;
64 local our @Body_Parts;
70 my ($this_mode, undef, undef, undef, $body) = @_;
71 $last_mode = $this_mode;
73 @last_q = expand_body($body);
79 $tcl->CreateCommand('?' => sub { q_command(query => @_) });
80 $tcl->CreateCommand('?!' => sub { q_command(solve => @_) });
81 $tcl->CreateCommand('!?' => sub { q_command(solve => @_) });
82 $tcl->CreateCommand('!' => sub { q_command(ensure => @_) });
84 $tcl->CreateCommand(run => sub {
85 foreach my $ind ($r->independent_actions) {
86 $solver->run_action($ind);
92 $tcl->CreateCommand(dump => sub {
93 my (undef, undef, undef, $to_dump) = @_;
94 my $filter = quote_sub($to_dump);
100 map { $_ =~ /^'(.*)'$/ ? \do { my $x = $1 } : $_ } @args;
104 my (undef, undef, $name, @args) = @_;
105 push our @Body_Parts, [ $name => mangle_args(@args) ];
109 $tcl->CreateCommand(rule => sub {
110 my (undef, undef, undef, $rule, $vars, $body) = @_;
111 $solver->add_rule($rule => expand_def($vars, $body));
112 $tcl->CreateCommand($rule => $rule_sub);
116 foreach my $rule (keys %{$solver->rule_set->rules}) {
118 $tcl->CreateCommand($rule => $rule_sub);
121 $tcl->CreateCommand(foreach => sub {
122 my (undef, undef, undef, $var, $body, $each_body) = @_;
123 push our @Body_Parts, [
124 foreach => $var => map [ expand_body($_) ], $body, $each_body
129 $tcl->CreateCommand(findall => sub {
130 my (undef, undef, undef, $coll_var, $name_var, $body) = @_;
131 push our @Body_Parts, [
132 findall => $coll_var => $name_var => expand_body($body)
137 $tcl->CreateCommand(not => sub {
138 my (undef, undef, undef, $body) = @_;
139 push our @Body_Parts, [ not => expand_body($body) ];
143 $tcl->CreateCommand(n => \&show);
145 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});
148 $tcl->EvalFile($ARGV[0]);
151 my $rl = Term::ReadLine->new;
155 while (defined(my $line = $rl->readline(length($cmd)?'> ':'$ '))) {
157 if ($tcl->call(info => complete => $cmd)) {
158 unless (eval { $tcl->Eval($cmd); 1 }) {