From 9f4d31a8256d6d4a523eb99b8afd652a3c68987a Mon Sep 17 00:00:00 2001 From: bakaq Date: Tue, 3 Sep 2024 12:44:10 -0300 Subject: [PATCH 1/7] Toplevel reimplementation with leaf answer callbacks --- src/loader.pl | 5 +- src/toplevel.pl | 142 +++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 142 insertions(+), 5 deletions(-) diff --git a/src/loader.pl b/src/loader.pl index 0998182d1..1c5ddabdc 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -19,10 +19,9 @@ % '$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 c6e2990d7..98b344ebb 100644 --- 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 @@ ( 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 @@ ; 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), From afa7af3de6208947a6291c03382e1f6e75894ab9 Mon Sep 17 00:00:00 2001 From: bakaq Date: Fri, 6 Sep 2024 14:19:11 -0300 Subject: [PATCH 2/7] Address review comments and remove old toplevel --- src/toplevel.pl | 160 ++++++++---------------------------------------- 1 file changed, 24 insertions(+), 136 deletions(-) diff --git a/src/toplevel.pl b/src/toplevel.pl index 98b344ebb..18995b43a 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -193,8 +193,7 @@ ( Item == user -> catch(load(user_input), E, print_exception_with_check(E)) ; - %submit_query_and_print_results(consult(Item), []) - submit_query_and_print_results2(consult(Item), []) + submit_query_and_print_results(consult(Item), []) ) ; catch(type_error(atom, Item, repl/0), E, @@ -203,20 +202,19 @@ ; Term = end_of_file -> halt ; - %submit_query_and_print_results(Term, VarList) - submit_query_and_print_results2(Term, VarList) + submit_query_and_print_results(Term, VarList) ). -run_query(Query, Callback_1) :- +run_query(Query, Callback_1, Options) :- read_term_from_chars(Query, QueryTerm, [variable_names(VarNames)]), - run_query_term(QueryTerm, VarNames, Callback_1). + run_query_goal(QueryTerm, VarNames, Callback_1, Options). -run_query_term(QueryTerm, VarNames, Callback_1) :- +run_query_goal(QueryGoal, 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), + catch(call_residue_vars(user:QueryGoal, ResVars), Exception, Excepted = true), gather_query_vars(VarNames, Vars0), '$term_variables_under_max_depth'(Vars0, 22, Vars1), '$project_atts':project_attributes(Vars1, ResVars), @@ -249,19 +247,18 @@ ) ) ). -run_query_term(_, _, Callback_1) :- +run_query_goal(_, _, 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) + % run_query_goal/4 (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) :- +submit_query_and_print_results(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), + run_query_goal(QueryTerm, VarNames, toplevel_query_callback, []), '$stop_query', true ). @@ -280,21 +277,20 @@ toplevel_query_callback(pending(LeafAnswer)) :- handle_first_answer, increment_answer_count, - show_leaf_answer(LeafAnswer, []), - read_input2(LeafAnswer). + write_leaf_answer(LeafAnswer, []), + read_input(LeafAnswer). toplevel_query_callback(final(LeafAnswer)) :- - ( subsumes_term(exception(_), LeafAnswer) -> - exception(Exception) = LeafAnswer, + ( exception(Exception) = LeafAnswer -> print_exception(Exception) ; handle_first_answer, increment_answer_count, - show_leaf_answer(LeafAnswer, []), + write_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) :- +write_leaf_answer(true, _) :- write(true). +write_leaf_answer(false, _) :- write(false). +write_leaf_answer(leaf_answer(Bindings, ResGoals, VarNames), Options) :- append(Bindings, ResGoals, LeafGoals), loader:thread_goals(LeafGoals, ThreadedGoals, (',')), ( member(depth(deep), Options) -> @@ -302,7 +298,7 @@ ; write_eq(ThreadedGoals, VarNames, 20) ). -read_input2(LeafAnswer) :- +read_input(LeafAnswer) :- ( bb_get('$report_all', true) -> C = n ; bb_get('$report_n_more', N), N > 1 -> @@ -314,20 +310,18 @@ ( C = w -> nl, write(' '), - show_leaf_answer(LeafAnswer, [depth(deep)]), - %write_eq(ThreadedGoals, NewVarList, 20), - read_input2(LeafAnswer) + write_leaf_answer(LeafAnswer, [depth(deep)]), + read_input(LeafAnswer) ; C = p -> nl, write(' '), - show_leaf_answer(LeafAnswer, [depth(shallow)]), - %write_eq(ThreadedGoals, NewVarList, 20), - read_input2(LeafAnswer) + write_leaf_answer(LeafAnswer, [depth(shallow)]), + read_input(LeafAnswer) ; member(C, [';', ' ', n]) -> nl, write('; ') ; C = h -> help_message, - read_input2(LeafAnswer) + read_input(LeafAnswer) ; member(C, ['\n', .]) -> nl, write('; ... .'), nl, throw('$stop_query') @@ -339,36 +333,9 @@ More is 5 - Count mod 5, bb_put('$report_n_more', More), nl, write('; ') - ; read_input2(LeafAnswer) + ; read_input(LeafAnswer) ). -submit_query_and_print_results_(Term, VarList) :- - '$get_b_value'(B), - bb_put('$report_all', false), - bb_put('$report_n_more', 0), - expand_goal(Term, user, Term0), - call_residue_vars(user:Term0, AttrVars), - write_eqs_and_read_input(B, VarList, AttrVars), - !. -submit_query_and_print_results_(_, _) :- - ( bb_get('$answer_count', 0) -> - write(' ') - ; true - ), - write('false.'), - nl. - - -submit_query_and_print_results(Term, VarList) :- - % ( functor(Term0, call, _) -> - % Term = Term0 % prevent pre-mature expansion of incomplete goal - % % in the first argument, which is done by call/N - % ; expand_goal(Term0, user, Term) - % ), - bb_put('$answer_count', 0), - submit_query_and_print_results_(Term, VarList). - - needs_bracketing(Value, Op) :- nonvar(Value), functor(Value, F, Arity), @@ -465,85 +432,6 @@ term_variables_under_max_depth(Term, MaxDepth, Vars) :- '$term_variables_under_max_depth'(Term, MaxDepth, Vars). -write_eqs_and_read_input(B, VarList, AttrVars) :- - gather_query_vars(VarList, OrigVars), - % one layer of depth added for (=/2) functor - '$term_variables_under_max_depth'(OrigVars, 22, Vars0), - '$project_atts':project_attributes(Vars0, AttrVars), - % Need to copy all the visible Vars here so that they appear - % properly in AttrGoals, even the non-attributed. Need to also - % copy all the attributed variables here so that anonymous - % attributed variables also appear properly in AttrGoals. - copy_term([Vars0, AttrVars], [Vars0, AttrVars], AttrGoals), - term_variables(AttrGoals, AttrGoalVars), - append([Vars0, AttrGoalVars, AttrVars], Vars), - charsio:extend_var_list(Vars, VarList, NewVarList, fabricated), - '$get_b_value'(B0), - gather_equations(NewVarList, OrigVars, Equations), - append(Equations, AttrGoals, Goals), - % one layer of depth added for (=/2) functor - maplist(\Term^Vs^term_variables_under_max_depth(Term, 22, Vs), Equations, EquationVars), - % maplist(term_variables_under_max_depth(22), Equations, EquationVars), - append([AttrGoalVars | EquationVars], Vars1), - term_variables(Vars1, Vars2), % deduplicate vars of Vars1 but preserve their order. - charsio:extend_var_list(Vars2, VarList, NewVarList0, fabricated), - bb_get('$answer_count', Count), - ( Count =:= 0 -> - write(' ') - ; true - ), - Count1 is Count + 1, - bb_put('$answer_count', Count1), - ( B0 == B -> - ( Goals == [] -> - write('true.'), nl - ; loader:thread_goals(Goals, ThreadedGoals, (',')), - write_eq(ThreadedGoals, NewVarList0, 20), - write('.'), - nl - ) - ; loader:thread_goals(Goals, ThreadedGoals, (',')), - write_eq(ThreadedGoals, NewVarList0, 20), - read_input(ThreadedGoals, NewVarList0) - ). - -read_input(ThreadedGoals, NewVarList) :- - ( 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(' '), - write_eq(ThreadedGoals, NewVarList, 0), - read_input(ThreadedGoals, NewVarList) - ; C = p -> - nl, - write(' '), - write_eq(ThreadedGoals, NewVarList, 20), - read_input(ThreadedGoals, NewVarList) - ; member(C, [';', ' ', n]) -> - nl, write('; '), false - ; C = h -> - help_message, - read_input(ThreadedGoals, NewVarList) - ; member(C, ['\n', .]) -> - nl, write('; ... .'), nl - ; C = a -> - bb_put('$report_all', true), - nl, write('; '), false - ; C = f -> - bb_get('$answer_count', Count), - More is 5 - Count mod 5, - bb_put('$report_n_more', More), - nl, write('; '), false - ; read_input(ThreadedGoals, NewVarList) - ). - help_message :- nl, nl, write('SPACE, "n" or ";": next solution, if any\n'), From e369c15a274edca750c1b0737c56495c2a1fe702 Mon Sep 17 00:00:00 2001 From: bakaq Date: Fri, 6 Sep 2024 14:55:39 -0300 Subject: [PATCH 3/7] Documentation for run_query/3 and run_query_goal/4 --- src/toplevel.pl | 38 ++++++++++++++++++++++++++++++++++---- 1 file changed, 34 insertions(+), 4 deletions(-) diff --git a/src/toplevel.pl b/src/toplevel.pl index 18995b43a..a2d465976 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -205,10 +205,40 @@ submit_query_and_print_results(Term, VarList) ). -run_query(Query, Callback_1, Options) :- - read_term_from_chars(Query, QueryTerm, [variable_names(VarNames)]), - run_query_goal(QueryTerm, VarNames, Callback_1, Options). - +%% run_query(+QueryChars, +Callback_1, +Options) +% +% Runs a query from a string of chars, calling `Callback_1` on each leaf answer. +% See `run_query_goal/4` for details. +run_query(QueryChars, Callback_1, Options) :- + read_term_from_chars(QueryChars, QueryGoal, [variable_names(VarNames)]), + run_query_goal(QueryGoal, VarNames, Callback_1, Options). + +%% run_query_goal(+QueryGoal, +VarNames, +Callback_1, +Options) +% +% Run a query from a goal, calling `Callback_1 on each leaf answer. +% `VarNames` needs to have the same format as the one from the `variable_names(-VarNames)` +% option in `read_term/3`. That is, a list of terms of the form `Name=Var`, where `Name` +% is an atom and `Var` is a variable. The possible arguments to `Callback_1` are: +% +% - `final(false)` +% - `final(exception(Exception))`, where `Exception` is the exception thrown +% - `final(true)` +% - `final(leaf_answer(Bindings, ResidualGoals, VarNames))`, where: +% +% - `Bindings` is a list of terms of the form `Var=Term`, where `Var` is a +% variable. +% - `ResidualGoals` is a list of the residual goals from the query. +% - `VarNames` is a list of `Name=Var` terms where `Name` is an atom and `Var` is a +% variable. +% - `pending(true)` +% - `pending(leaf_answer(Bindings, ResidualGoals, VarNames)`, see `final(leaf_answer(_,_,_))` +% above. +% +% The variants with principal functor `final/1` mean that there will be no more leaf answers, +% and the ones with `pending/1` mean that there will be more leaf answers. +% +% `Option` is a list of options. There are none currently, but in the future support for +% inference limits and timeouts may be implemented. run_query_goal(QueryGoal, 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 From a885e87ef7c85d47e342afa34916b577d913b423 Mon Sep 17 00:00:00 2001 From: bakaq Date: Fri, 6 Sep 2024 14:59:17 -0300 Subject: [PATCH 4/7] Add argument with extra info to callback --- src/toplevel.pl | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/toplevel.pl b/src/toplevel.pl index a2d465976..a736de6e4 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -205,20 +205,20 @@ submit_query_and_print_results(Term, VarList) ). -%% run_query(+QueryChars, +Callback_1, +Options) +%% run_query(+QueryChars, +Callback_2, +Options) % -% Runs a query from a string of chars, calling `Callback_1` on each leaf answer. +% Runs a query from a string of chars, calling `Callback_2` on each leaf answer. % See `run_query_goal/4` for details. -run_query(QueryChars, Callback_1, Options) :- +run_query(QueryChars, Callback_2, Options) :- read_term_from_chars(QueryChars, QueryGoal, [variable_names(VarNames)]), - run_query_goal(QueryGoal, VarNames, Callback_1, Options). + run_query_goal(QueryGoal, VarNames, Callback_2, Options). -%% run_query_goal(+QueryGoal, +VarNames, +Callback_1, +Options) +%% run_query_goal(+QueryGoal, +VarNames, +Callback_2, +Options) % -% Run a query from a goal, calling `Callback_1 on each leaf answer. +% Run a query from a goal, calling `Callback_2` on each leaf answer. % `VarNames` needs to have the same format as the one from the `variable_names(-VarNames)` % option in `read_term/3`. That is, a list of terms of the form `Name=Var`, where `Name` -% is an atom and `Var` is a variable. The possible arguments to `Callback_1` are: +% is an atom and `Var` is a variable. The possible first arguments to `Callback_2` are: % % - `final(false)` % - `final(exception(Exception))`, where `Exception` is the exception thrown @@ -237,9 +237,11 @@ % The variants with principal functor `final/1` mean that there will be no more leaf answers, % and the ones with `pending/1` mean that there will be more leaf answers. % +% The second argument is a list with extra information that can be activated with options. +% % `Option` is a list of options. There are none currently, but in the future support for % inference limits and timeouts may be implemented. -run_query_goal(QueryGoal, VarNames, Callback_1, _) :- +run_query_goal(QueryGoal, VarNames, Callback_2, _) :- % 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. @@ -256,11 +258,11 @@ ), ( Excepted == true -> !, - call(Callback_1, final(exception(Exception))) + call(Callback_2, final(exception(Exception)), []) ; ( VarNames == [], ResGoals == [] -> ( Pending == true -> - call(Callback_1, pending(true)) - ; call(Callback_1, final(true)) + call(Callback_2, pending(true), []) + ; call(Callback_2, final(true), []) ) ; copy_term([Vars1, ResVars], [Vars1, ResVars], ResGoals), term_variables(ResGoals, ResGoalVars), @@ -272,16 +274,16 @@ 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))) + call(Callback_2, pending(leaf_answer(Bindings, ResGoals, NewVarNames1)), []) + ; call(Callback_2, final(leaf_answer(Bindings, ResGoals, NewVarNames1)), []) ) ) ). -run_query_goal(_, _, Callback_1, _) :- +run_query_goal(_, _, Callback_2, _) :- % If the whole query failed or we didn't cut in the previous definition of % run_query_goal/4 (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)). + call(Callback_2, final(false), []). submit_query_and_print_results(QueryTerm, VarNames) :- bb_put('$answer_count', 0), @@ -304,12 +306,12 @@ Count is Count0 + 1, bb_put('$answer_count', Count). -toplevel_query_callback(pending(LeafAnswer)) :- +toplevel_query_callback(pending(LeafAnswer), _) :- handle_first_answer, increment_answer_count, write_leaf_answer(LeafAnswer, []), read_input(LeafAnswer). -toplevel_query_callback(final(LeafAnswer)) :- +toplevel_query_callback(final(LeafAnswer), _) :- ( exception(Exception) = LeafAnswer -> print_exception(Exception) ; handle_first_answer, From fdd6579230f2cddb422e447edbe3a7048850e447 Mon Sep 17 00:00:00 2001 From: bakaq Date: Sat, 7 Sep 2024 02:06:01 -0300 Subject: [PATCH 5/7] Add mechanism to stop query --- src/toplevel.pl | 122 ++++++++++++++++++++++++++---------------------- 1 file changed, 67 insertions(+), 55 deletions(-) diff --git a/src/toplevel.pl b/src/toplevel.pl index a736de6e4..2bdc41832 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -192,8 +192,7 @@ ( atom(Item) -> ( 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), []) ) ; catch(type_error(atom, Item, repl/0), E, @@ -201,24 +200,24 @@ ) ; Term = end_of_file -> halt - ; - submit_query_and_print_results(Term, VarList) + ; submit_query_and_print_results(Term, VarList) ). -%% run_query(+QueryChars, +Callback_2, +Options) +%% run_query(+QueryChars, +Callback_3, +Options) % -% Runs a query from a string of chars, calling `Callback_2` on each leaf answer. +% Runs a query from a string of chars, calling `Callback_3` on each leaf answer. % See `run_query_goal/4` for details. -run_query(QueryChars, Callback_2, Options) :- +run_query(QueryChars, Callback_3, Options) :- read_term_from_chars(QueryChars, QueryGoal, [variable_names(VarNames)]), - run_query_goal(QueryGoal, VarNames, Callback_2, Options). + run_query_goal(QueryGoal, VarNames, Callback_3, Options). -%% run_query_goal(+QueryGoal, +VarNames, +Callback_2, +Options) +%% run_query_goal(+QueryGoal, +VarNames, +Callback_3, +Options) % -% Run a query from a goal, calling `Callback_2` on each leaf answer. +% Run a query from a goal, calling `Callback_3` on each leaf answer. % `VarNames` needs to have the same format as the one from the `variable_names(-VarNames)` % option in `read_term/3`. That is, a list of terms of the form `Name=Var`, where `Name` -% is an atom and `Var` is a variable. The possible first arguments to `Callback_2` are: +% is an atom and `Var` is a variable. `Callback_3` should have the form +% `callback(+LeafAnswer, +Info, -Stop)`, where `LeafAnswer` will be one of those: % % - `final(false)` % - `final(exception(Exception))`, where `Exception` is the exception thrown @@ -237,11 +236,13 @@ % The variants with principal functor `final/1` mean that there will be no more leaf answers, % and the ones with `pending/1` mean that there will be more leaf answers. % -% The second argument is a list with extra information that can be activated with options. +% The second argument of the callback (`Info`) is a list with extra information that can +% be activated with options. The third argument `Stop` controls whether the query will continue +% or stop, and should be instantiated by the callback to either `continue` or `stop`. % % `Option` is a list of options. There are none currently, but in the future support for % inference limits and timeouts may be implemented. -run_query_goal(QueryGoal, VarNames, Callback_2, _) :- +run_query_goal(QueryGoal, VarNames, Callback_3, _) :- % 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. @@ -258,11 +259,15 @@ ), ( Excepted == true -> !, - call(Callback_2, final(exception(Exception)), []) + call(Callback_3, final(exception(Exception)), [], _) ; ( VarNames == [], ResGoals == [] -> ( Pending == true -> - call(Callback_2, pending(true), []) - ; call(Callback_2, final(true), []) + call(Callback_3, pending(true), [], Stop), + ( Stop == stop -> ! + ; Stop == continue -> true + ; domain_error(stop_or_continue, Stop, run_query_goal/4) + ) + ; call(Callback_3, final(true), [], _) ) ; copy_term([Vars1, ResVars], [Vars1, ResVars], ResGoals), term_variables(ResGoals, ResGoalVars), @@ -274,26 +279,31 @@ term_variables(Vars3, Vars4), % deduplicate vars of Vars1 but preserve their order. charsio:extend_var_list(Vars4, VarNames, NewVarNames1, fabricated), ( Pending == true -> - call(Callback_2, pending(leaf_answer(Bindings, ResGoals, NewVarNames1)), []) - ; call(Callback_2, final(leaf_answer(Bindings, ResGoals, NewVarNames1)), []) + call( + Callback_3, + pending(leaf_answer(Bindings, ResGoals, NewVarNames1)), + [], + Stop + ), + ( Stop == stop -> ! + ; Stop == continue -> true + ; domain_error(stop_or_continue, Stop, run_query_goal/4) + ) + ; call(Callback_3, final(leaf_answer(Bindings, ResGoals, NewVarNames1)), [], _) ) ) ). -run_query_goal(_, _, Callback_2, _) :- +run_query_goal(_, _, Callback_3, _) :- % If the whole query failed or we didn't cut in the previous definition of % run_query_goal/4 (which means we are still in the query but it has failed) % then we get here so we have a (tail) false. - call(Callback_2, final(false), []). + call(Callback_3, final(false), [], _). submit_query_and_print_results(QueryTerm, VarNames) :- bb_put('$answer_count', 0), bb_put('$report_all', false), bb_put('$report_n_more', 0), - catch( - run_query_goal(QueryTerm, VarNames, toplevel_query_callback, []), - '$stop_query', - true - ). + run_query_goal(QueryTerm, VarNames, toplevel_query_callback, []). handle_first_answer :- ( bb_get('$answer_count', 0) -> @@ -306,12 +316,12 @@ Count is Count0 + 1, bb_put('$answer_count', Count). -toplevel_query_callback(pending(LeafAnswer), _) :- +toplevel_query_callback(pending(LeafAnswer), _, Stop) :- handle_first_answer, increment_answer_count, write_leaf_answer(LeafAnswer, []), - read_input(LeafAnswer). -toplevel_query_callback(final(LeafAnswer), _) :- + read_input(LeafAnswer, Stop). +toplevel_query_callback(final(LeafAnswer), _, continue) :- ( exception(Exception) = LeafAnswer -> print_exception(Exception) ; handle_first_answer, @@ -330,7 +340,7 @@ ; write_eq(ThreadedGoals, VarNames, 20) ). -read_input(LeafAnswer) :- +read_input(LeafAnswer, Stop) :- ( bb_get('$report_all', true) -> C = n ; bb_get('$report_n_more', N), N > 1 -> @@ -339,33 +349,35 @@ C = n ; get_single_char(C) ), - ( C = w -> - nl, - write(' '), - write_leaf_answer(LeafAnswer, [depth(deep)]), - read_input(LeafAnswer) - ; C = p -> - nl, - write(' '), - write_leaf_answer(LeafAnswer, [depth(shallow)]), - read_input(LeafAnswer) - ; member(C, [';', ' ', n]) -> - nl, write('; ') - ; C = h -> - help_message, - read_input(LeafAnswer) - ; member(C, ['\n', .]) -> + ( 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_input(LeafAnswer) + Stop = stop + ; Stop = continue, + ( C = w -> + nl, + write(' '), + write_leaf_answer(LeafAnswer, [depth(deep)]), + read_input(LeafAnswer) + ; C = p -> + nl, + write(' '), + write_leaf_answer(LeafAnswer, [depth(shallow)]), + read_input(LeafAnswer) + ; member(C, [';', ' ', n]) -> + nl, write('; ') + ; C = h -> + help_message, + read_input(LeafAnswer) + ; 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_input(LeafAnswer) + ) ). needs_bracketing(Value, Op) :- From 190929e4ac9e63c81268d2a1e29abff8f637b725 Mon Sep 17 00:00:00 2001 From: bakaq Date: Tue, 1 Oct 2024 21:58:59 -0300 Subject: [PATCH 6/7] Remove trailing whitespace in toplevel.pl --- src/toplevel.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/toplevel.pl b/src/toplevel.pl index 2bdc41832..090d20947 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -170,8 +170,8 @@ %% Enable op declarations with lists of operands, i.e., %% :- op(900, fy, [$,@]). -user:term_expansion((:- op(Pred, Spec, Ops)), OpResults) :- - ground(Ops), +user:term_expansion((:- op(Pred, Spec, Ops)), OpResults) :- + ground(Ops), Ops = [Op | OtherOps], expand_op_list([Op | OtherOps], Pred, Spec, OpResults). @@ -223,7 +223,7 @@ % - `final(exception(Exception))`, where `Exception` is the exception thrown % - `final(true)` % - `final(leaf_answer(Bindings, ResidualGoals, VarNames))`, where: -% +% % - `Bindings` is a list of terms of the form `Var=Term`, where `Var` is a % variable. % - `ResidualGoals` is a list of the residual goals from the query. From 90d418a181397d5cc19991295c93d66c83b566fb Mon Sep 17 00:00:00 2001 From: bakaq Date: Sat, 12 Oct 2024 23:37:58 -0300 Subject: [PATCH 7/7] Fix priority in op/3 --- src/toplevel.pl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/toplevel.pl b/src/toplevel.pl index 090d20947..e60791067 100644 --- a/src/toplevel.pl +++ b/src/toplevel.pl @@ -170,14 +170,14 @@ %% Enable op declarations with lists of operands, i.e., %% :- op(900, fy, [$,@]). -user:term_expansion((:- op(Pred, Spec, Ops)), OpResults) :- +user:term_expansion((:- op(Pri, Spec, Ops)), OpResults) :- ground(Ops), Ops = [Op | OtherOps], - expand_op_list([Op | OtherOps], Pred, Spec, OpResults). + expand_op_list([Op | OtherOps], Pri, Spec, OpResults). expand_op_list([], _, _, []). -expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResults]) :- - expand_op_list(OtherOps, Pred, Spec, OtherResults). +expand_op_list([Op | OtherOps], Pri, Spec, [(:- op(Pri, Spec, Op)) | OtherResults]) :- + expand_op_list(OtherOps, Pri, Spec, OtherResults). read_and_match :-