Toplevel reimplementation with leaf answer callbacks

diff --git a/src/loader.pl b/src/loader.pl
index 0998182d1ad767e4af095c2ae69541f1d3ceaf92..1c5ddabdc0cd1604fe280c226ea256e3ec4d7531 100644 (file)
--- a/src/loader.pl
+++ b/src/loader.pl
@@ -19,10 +19,9 @@ write_error(Error) :-
     % '$fetch_global_var' is the core system call of bb_get/2, but
     % bb_get may not exist when write_error is first called, so fall
     % back on '$fetch_global_var'.
-    (  '$fetch_global_var'('$first_answer', false) ->
+    (  '$fetch_global_var'('$answer_count', C), C =\= 0 ->
        true
-    ;  write('   ') % if '$first_answer' isn't defined yet or true,
-                    % print indentation.
+    ;  write('   ') % if still in the first answer print indentation.
     ),
     (  current_prolog_flag(double_quotes, chars) ->
        DQ = true

diff --git a/src/toplevel.pl b/src/toplevel.pl
index c6e2990d7ec1f430c4a5fabb349b68fba62614c2..98b344ebbbc7a706653e2d0c07cb71556e397632 100644 (file)
--- a/src/toplevel.pl
+++ b/src/toplevel.pl
@@ -9,6 +9,8 @@
 :- use_module(library(si)).
 :- use_module(library(os)).
 
+:- use_module(library(format)).
+
 :- use_module(library('$project_atts')).
 :- use_module(library('$atts')).
 
@@ -191,7 +193,8 @@ instruction_match(Term, VarList) :-
           (  Item == user ->
              catch(load(user_input), E, print_exception_with_check(E))
           ;
-             submit_query_and_print_results(consult(Item), [])
+             %submit_query_and_print_results(consult(Item), [])
+             submit_query_and_print_results2(consult(Item), [])
           )
        ;  catch(type_error(atom, Item, repl/0),
                 E,
@@ -200,9 +203,144 @@ instruction_match(Term, VarList) :-
     ;  Term = end_of_file ->
        halt
     ;
-       submit_query_and_print_results(Term, VarList)
+        %submit_query_and_print_results(Term, VarList)
+       submit_query_and_print_results2(Term, VarList)
     ).
 
+run_query(Query, Callback_1) :-
+    read_term_from_chars(Query, QueryTerm, [variable_names(VarNames)]),
+    run_query_term(QueryTerm, VarNames, Callback_1).
+
+run_query_term(QueryTerm, VarNames, Callback_1) :-
+    % The b value in the WAM basically represents which choicepoint we are at.
+    % By recording it before and after we can then compare the values to know
+    % if we are still inside the query or not.
+    '$get_b_value'(B0),
+    catch(call_residue_vars(user:QueryTerm, ResVars), Exception, Excepted = true),
+    gather_query_vars(VarNames, Vars0),
+    '$term_variables_under_max_depth'(Vars0, 22, Vars1),
+    '$project_atts':project_attributes(Vars1, ResVars),
+    '$get_b_value'(B),
+    (   B0 == B ->
+        % We are out of the choicepoint, ignore tail false
+        !
+    ;   Pending = true
+    ),
+    (   Excepted == true ->
+        !,
+        call(Callback_1, final(exception(Exception)))
+    ;   (   VarNames == [], ResGoals == [] ->
+            (   Pending == true ->
+                call(Callback_1, pending(true))
+            ;   call(Callback_1, final(true))
+            )
+        ;   copy_term([Vars1, ResVars], [Vars1, ResVars], ResGoals),
+            term_variables(ResGoals, ResGoalVars),
+            append([Vars1, ResGoalVars, ResVars], Vars2),
+            charsio:extend_var_list(Vars2, VarNames, NewVarNames, fabricated),
+            gather_equations(NewVarNames, Vars0, Bindings),
+            maplist(\Term^Vs^term_variables_under_max_depth(Term, 22, Vs), Bindings, BindingVars),
+            append([ResGoalVars | BindingVars], Vars3),
+            term_variables(Vars3, Vars4), % deduplicate vars of Vars1 but preserve their order.
+            charsio:extend_var_list(Vars4, VarNames, NewVarNames1, fabricated),
+            (   Pending == true ->
+                call(Callback_1, pending(leaf_answer(Bindings, ResGoals, NewVarNames1)))
+            ;   call(Callback_1, final(leaf_answer(Bindings, ResGoals, NewVarNames1)))
+            )
+        )
+    ).
+run_query_term(_, _, Callback_1) :-
+    % If the whole query failed or we didn't cut in the previous definition of
+    % run_query_term/3 (which means  we are still in the query but it has failed)
+    % then we get here so we have a (tail) false.
+    call(Callback_1, final(false)).
+
+
+submit_query_and_print_results2(QueryTerm, VarNames) :-
+    bb_put('$answer_count', 0),
+    bb_put('$report_all', false),
+    bb_put('$report_n_more', 0),
+    catch(
+        run_query_term(QueryTerm, VarNames, toplevel_query_callback),
+        '$stop_query',
+        true
+    ).
+
+handle_first_answer :-
+    (   bb_get('$answer_count', 0) ->
+        write('   ')
+    ;   true
+    ).
+
+increment_answer_count :-
+    bb_get('$answer_count', Count0),
+    Count is Count0 + 1,
+    bb_put('$answer_count', Count).
+
+toplevel_query_callback(pending(LeafAnswer)) :-
+    handle_first_answer,
+    increment_answer_count,
+    show_leaf_answer(LeafAnswer, []),
+    read_input2(LeafAnswer).
+toplevel_query_callback(final(LeafAnswer)) :-
+    (   subsumes_term(exception(_), LeafAnswer) ->
+        exception(Exception) = LeafAnswer,
+        print_exception(Exception)
+    ;   handle_first_answer,
+        increment_answer_count,
+        show_leaf_answer(LeafAnswer, []),
+        write('.'), nl
+    ).
+
+show_leaf_answer(true, _) :- write(true).
+show_leaf_answer(false, _) :- write(false).
+show_leaf_answer(leaf_answer(Bindings, ResGoals, VarNames), Options) :-
+    append(Bindings, ResGoals, LeafGoals),
+    loader:thread_goals(LeafGoals, ThreadedGoals, (',')),
+    (   member(depth(deep), Options) ->
+        write_eq(ThreadedGoals, VarNames, 0)
+    ;   write_eq(ThreadedGoals, VarNames, 20)
+    ).
+
+read_input2(LeafAnswer) :-
+    (  bb_get('$report_all', true) ->
+       C = n
+    ;  bb_get('$report_n_more', N), N > 1 ->
+       N1 is N - 1,
+       bb_put('$report_n_more', N1),
+       C = n
+    ;  get_single_char(C)
+    ),
+    (  C = w ->
+       nl,
+       write('   '),
+       show_leaf_answer(LeafAnswer, [depth(deep)]),
+       %write_eq(ThreadedGoals, NewVarList, 20),
+       read_input2(LeafAnswer)
+    ;  C = p ->
+       nl,
+       write('   '),
+       show_leaf_answer(LeafAnswer, [depth(shallow)]),
+       %write_eq(ThreadedGoals, NewVarList, 20),
+       read_input2(LeafAnswer)
+    ;  member(C, [';', ' ', n]) ->
+       nl, write(';  ')
+    ;  C = h ->
+       help_message,
+       read_input2(LeafAnswer)
+    ;  member(C, ['\n', .]) ->
+       nl, write(';  ... .'), nl,
+       throw('$stop_query')
+    ;  C = a ->
+       bb_put('$report_all', true),
+       nl, write(';  ')
+    ;  C = f ->
+       bb_get('$answer_count', Count),
+       More is 5 - Count mod 5,
+       bb_put('$report_n_more', More),
+       nl, write(';  ')
+    ;  read_input2(LeafAnswer)
+    ).
 
 submit_query_and_print_results_(Term, VarList) :-
     '$get_b_value'(B),