Add when/2 and when_si/2

diff --git a/src/lib/si.pl b/src/lib/si.pl
index ac28b43c4c0af8a49e49917b8665effe8882070b..0e29c190d0879b108406733ba45015175a2daf64 100644 (file)
--- 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 (file)
index 0000000..28a5095
--- /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(_)) }.