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 local our @Body_Parts;
69 my ($this_mode, undef, undef, undef, $body) = @_;
70 $last_mode = $this_mode;
72 @last_q = expand_body($body);
78 $tcl->CreateCommand('?' => sub { q_command(query => @_) });
79 $tcl->CreateCommand('?!' => sub { q_command(solve => @_) });
80 $tcl->CreateCommand('!?' => sub { q_command(solve => @_) });
81 $tcl->CreateCommand('!' => sub { q_command(ensure => @_) });
83 $tcl->CreateCommand(run => sub {
84 foreach my $ind ($r->independent_actions) {
85 $solver->run_action($ind);
91 $tcl->CreateCommand(dump => sub {
92 my (undef, undef, undef, $to_dump) = @_;
93 my $filter = quote_sub($to_dump);
99 map { $_ =~ /^'(.*)'$/ ? \do { my $x = $1 } : $_ } @args;
103 my (undef, undef, $name, @args) = @_;
104 push our @Body_Parts, [ $name => mangle_args(@args) ];
108 $tcl->CreateCommand(rule => sub {
109 my (undef, undef, undef, $rule, $vars, $body) = @_;
110 $solver->add_rule($rule => expand_def($vars, $body));
111 $tcl->CreateCommand($rule => $rule_sub);
115 foreach my $rule (keys %{$solver->rule_set->rules}) {
117 $tcl->CreateCommand($rule => $rule_sub);
120 $tcl->CreateCommand(foreach => sub {
121 my (undef, undef, undef, $var, $body, $each_body) = @_;
122 push our @Body_Parts, [
123 foreach => $var => map [ expand_body($_) ], $body, $each_body
128 $tcl->CreateCommand(findall => sub {
129 my (undef, undef, undef, $coll_var, $name_var, $body) = @_;
130 push our @Body_Parts, [
131 findall => $coll_var => $name_var => expand_body($body)
136 $tcl->CreateCommand(n => \&show);
138 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});
141 $tcl->EvalFile($ARGV[0]);
144 my $rl = Term::ReadLine->new;
148 while (defined(my $line = $rl->readline(length($cmd)?'> ':'$ '))) {
150 if ($tcl->call(info => complete => $cmd)) {
151 unless (eval { $tcl->Eval($cmd); 1 }) {