From 6a30ccc9075670907b47648a03f510266c553530 Mon Sep 17 00:00:00 2001 From: bakaq Date: Sun, 10 Dec 2023 20:55:50 -0300 Subject: [PATCH 1/2] Add when/2 and when_si/2 --- src/lib/si.pl | 31 ++++++++++++++- src/lib/when.pl | 103 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 133 insertions(+), 1 deletion(-) create mode 100644 src/lib/when.pl diff --git a/src/lib/si.pl b/src/lib/si.pl index ac28b43c..0e29c190 100644 --- a/src/lib/si.pl +++ b/src/lib/si.pl @@ -39,7 +39,8 @@ character_si/1, term_si/1, chars_si/1, - dif_si/2]). + dif_si/2, + when_si/2]). :- use_module(library(lists)). @@ -98,3 +99,31 @@ dif_si(X, Y) :- ( X \= Y -> true ; throw(error(instantiation_error,dif_si/2)) ). + +:- meta_predicate(when_si(+, 0)). + +%% when_si(Condition, Goal). +% +% Executes Goal when Condition becomes true. Throws an instantiation error if +% it can't decide. +when_si(Condition, Goal) :- + % Taken from https://stackoverflow.com/a/40449516 + ( when_condition_si(Condition) -> + ( Condition -> + Goal + ; throw(error(instantiation_error,when_si/2)) + ) + ; throw(error(domain_error(when_condition_si, Condition),_)) + ). + +when_condition_si(Cond) :- + var(Cond), !, throw(error(instantiation_error,when_condition_si/2)). +when_condition_si(ground(_)). +when_condition_si(nonvar(_)). +when_condition_si((A, B)) :- + when_condition_si(A), + when_condition_si(B). +when_condition_si((A ; B)) :- + when_condition_si(A), + when_condition_si(B). + diff --git a/src/lib/when.pl b/src/lib/when.pl new file mode 100644 index 00000000..28a50955 --- /dev/null +++ b/src/lib/when.pl @@ -0,0 +1,103 @@ +/** +Provides the predicate `when/2`. +*/ + +:- module(when, [when/2]). + +:- use_module(library(atts)). +:- use_module(library(dcgs)). +:- use_module(library(lists)). +:- use_module(library(lambda)). + +:- attribute when_list/1. + +:- meta_predicate(when(+, 0)). + +%% when(Condition, Goal). +% +% Executes Goal when Condition becomes true. +when(Condition, Goal) :- + ( when_condition(Condition) -> + ( Condition -> + Goal + ; term_variables(Condition, Vars), + maplist( + [Goal, Condition]+\Var^( + get_atts(Var, when_list(Whens0)) -> + Whens = [when(Condition, Goal) | Whens0], + put_atts(Var, when_list(Whens)) + ; put_atts(Var, when_list([when(Condition, Goal)])) + ), + Vars + ) + ) + ; throw(error(domain_error(when_condition, Condition),_)) + ). + +when_condition(Cond) :- + % Should this be delayed? + var(Cond), !, throw(error(instantiation_error,when_condition/1)). +when_condition(ground(_)). +when_condition(nonvar(_)). +when_condition((A, B)) :- + when_condition(A), + when_condition(B). +when_condition((A ; B)) :- + when_condition(A), + when_condition(B). + +remove_goal([], _, []). +remove_goal([G0|G0s], Goal, Goals) :- + ( G0 == Goal -> + remove_goal(G0s, Goal, Goals) + ; Goals = [G0|Goals1], + remove_goal(G0, Goal, Goals1) + ). + +vars_remove_goal(Vars, Goal) :- + maplist( + Goal+\Var^( + get_atts(Var, when_list(Whens0)) -> + remove_goal(Whens0, Goal, Whens), + ( Whens = [] -> + put_atts(Var, -when_list(_)) + ; put_atts(Var, when_list(Whens)) + ) + ; true + ), + Vars + ). + +reinforce_goal(Goal0, Goal) :- + Goal = ( + term_variables(Goal0, Vars), + when:vars_remove_goal(Vars, Goal0), + Goal0 + ). + +verify_attributes(Var, Value, Goals) :- + ( get_atts(Var, when_list(Whens)) -> + ( var(Value) -> + ( get_atts(Value, when_list(WhensValue)) -> + append(Whens, WhensValue, WhensNew), + put_atts(Value, when_list(WhensNew)) + ; put_atts(Value, when_list(Whens)) + ), + Goals = [] + ; maplist(reinforce_goal, Whens, Goals) + ) + ; Goals = [] + ). + +gather_when_goals([], _) --> []. +gather_when_goals([When|Whens], Var) --> + ( { term_variables(When, [V0|_]), Var == V0 } -> + [when:When] + ; [] + ), + gather_when_goals(Whens, Var). + +attribute_goals(Var) --> + { get_atts(Var, when_list(Whens)) }, + gather_when_goals(Whens, Var), + { put_atts(Var, -when_list(_)) }. From f411fb1eb3f0aa238482aca4914454ba8e7b4cb2 Mon Sep 17 00:00:00 2001 From: bakaq Date: Mon, 11 Dec 2023 12:28:59 -0300 Subject: [PATCH 2/2] Tests for when/2 and solved bug --- src/lib/when.pl | 5 +- src/tests/when.pl | 145 +++++++++++++++++++ tests/scryer/cli/src_tests/when_tests.stderr | 0 tests/scryer/cli/src_tests/when_tests.stdout | 1 + tests/scryer/cli/src_tests/when_tests.toml | 1 + 5 files changed, 151 insertions(+), 1 deletion(-) create mode 100644 src/tests/when.pl create mode 100644 tests/scryer/cli/src_tests/when_tests.stderr create mode 100644 tests/scryer/cli/src_tests/when_tests.stdout create mode 100644 tests/scryer/cli/src_tests/when_tests.toml diff --git a/src/lib/when.pl b/src/lib/when.pl index 28a50955..56734057 100644 --- a/src/lib/when.pl +++ b/src/lib/when.pl @@ -9,6 +9,9 @@ Provides the predicate `when/2`. :- use_module(library(lists)). :- use_module(library(lambda)). +:- use_module(library(format)). +:- use_module(library(debug)). + :- attribute when_list/1. :- meta_predicate(when(+, 0)). @@ -51,7 +54,7 @@ remove_goal([G0|G0s], Goal, Goals) :- ( G0 == Goal -> remove_goal(G0s, Goal, Goals) ; Goals = [G0|Goals1], - remove_goal(G0, Goal, Goals1) + remove_goal(G0s, Goal, Goals1) ). vars_remove_goal(Vars, Goal) :- diff --git a/src/tests/when.pl b/src/tests/when.pl new file mode 100644 index 00000000..197d2ee7 --- /dev/null +++ b/src/tests/when.pl @@ -0,0 +1,145 @@ +/**/ + +:- use_module(library(format)). +:- use_module(library(dcgs)). +:- use_module(library(lists)). +:- use_module(library(debug)). +:- use_module(library(atts)). + +:- use_module(library(when)). + +test("condition true before ground/1",( + A = 1, + when(ground(A), Run = true), + Run == true +)). + +test("condition true before nonvar/1",( + A = a(_), + when(nonvar(A), Run = true), + Run == true +)). + +test("condition true before ','/2",( + A = 1, + B = a(_), + when((ground(A), nonvar(B)), Run = true), + Run == true +)). + +test("condition true before (;)/2",( + A = 1, + when((ground(A) ; nonvar(_)), Run1 = true), + Run1 == true, + + B = a(_), + when((ground(_) ; nonvar(B)), Run2 = true), + Run2 == true +)). + +test("condition true after ground/1",( + when(ground(A), Run = true), + var(Run), + A = 1, + Run == true +)). + +test("condition true after nonvar/1",( + when(nonvar(A), Run = true), + var(Run), + A = a(_), + Run == true +)). + +test("condition true after ','/2",( + when((ground(A), nonvar(B)), Run = true), + var(Run), + A = 1, + var(Run), + B = a(_), + Run == true +)). + +test("condition true after (;)/2",( + when((ground(A) ; nonvar(_)), Run1 = true), + var(Run1), + A = 1, + Run1 == true, + + when((ground(_) ; nonvar(B)), Run2 = true), + var(Run2), + B = a(_), + Run2 == true +)). + +test("multiple when/2 on same variable",( + when(nonvar(A), Run1 = true), + when(ground(A), Run2 = true), + var(Run1), var(Run2), + A = a(B), + Run1 == true, var(Run2), + B = 1, + Run2 == true +)). + +main :- + findall(test(Name, Goal), test(Name, Goal), Tests), + run_tests(Tests, Failed), + show_failed(Failed), + halt. + +main_quiet :- + findall(test(Name, Goal), test(Name, Goal), Tests), + run_tests_quiet(Tests, Failed), + ( Failed = [] -> + format("All tests passed", []) + ; format("Some tests failed", []) + ), + halt. + +portray_failed_([]) --> []. +portray_failed_([F|Fs]) --> + "\"", F, "\"", "\n", portray_failed_(Fs). + +portray_failed([]) --> []. +portray_failed([F|Fs]) --> + "\n", "Failed tests:", "\n", portray_failed_([F|Fs]). + +show_failed(Failed) :- + phrase(portray_failed(Failed), F), + format("~s", [F]). + +run_tests([], []). +run_tests([test(Name, Goal)|Tests], Failed) :- + format("Running test \"~s\"~n", [Name]), + ( call(Goal) -> + Failed = Failed1 + ; format("Failed test \"~s\"~n", [Name]), + Failed = [Name|Failed1] + ), + run_tests(Tests, Failed1). + +run_tests_quiet([], []). +run_tests_quiet([test(Name, Goal)|Tests], Failed) :- + ( call(Goal) -> + Failed = Failed1 + ; Failed = [Name|Failed1] + ), + run_tests_quiet(Tests, Failed1). + +assert_p(A, B) :- + phrase(portray_clause_(A), Portrayed), + phrase((B, ".\n"), Portrayed). + +call_residual_goals(Goal, ResidualGoals) :- + call_residue_vars(Goal, Vars), + variables_residual_goals(Vars, ResidualGoals). + +variables_residual_goals(Vars, Goals) :- + phrase(variables_residual_goals(Vars), Goals). + +variables_residual_goals([]) --> []. +variables_residual_goals([Var|Vars]) --> + dif_:attribute_goals(Var), + variables_residual_goals(Vars). + diff --git a/tests/scryer/cli/src_tests/when_tests.stderr b/tests/scryer/cli/src_tests/when_tests.stderr new file mode 100644 index 00000000..e69de29b diff --git a/tests/scryer/cli/src_tests/when_tests.stdout b/tests/scryer/cli/src_tests/when_tests.stdout new file mode 100644 index 00000000..4952cede --- /dev/null +++ b/tests/scryer/cli/src_tests/when_tests.stdout @@ -0,0 +1 @@ +All tests passed \ No newline at end of file diff --git a/tests/scryer/cli/src_tests/when_tests.toml b/tests/scryer/cli/src_tests/when_tests.toml new file mode 100644 index 00000000..ff0a5330 --- /dev/null +++ b/tests/scryer/cli/src_tests/when_tests.toml @@ -0,0 +1 @@ +args = ["-f", "--no-add-history", "src/tests/when.pl", "-f", "-g", "main_quiet"]