eyeprolog 1.3.78 → 1.3.80

package/src/lib/random.pl

@@ -1,6 +1,48 @@
-/** Reproducible pseudo-random values with explicit state. */
+/** Reproducible pseudo-random values.
 
-:- module(random, [random/3]).
+    random/3 is EyeProlog's explicit-state interface.  maybe/0,
+    random_integer/3, and set_random/1 are the common Scryer/Trealla library
+    interface; they use a non-backtrackable seed while retaining the same
+    Park-Miller generator.
+*/
+
+:- module(random, [maybe/0, random/3, random_integer/3, set_random/1]).
+
+:- use_module(library(debug), [bb_global_get/2, bb_put/2]).
+:- use_module(library(error), [instantiation_error/1, type_error/3]).
+
+maybe :-
+    random_integer(0, 2, 0).
+
+random_integer(Lower, Upper, R) :-
+    ( var(Lower) -> instantiation_error(random_integer/3)
+    ; var(Upper) -> instantiation_error(random_integer/3)
+    ; integer(Lower) -> true
+    ; type_error(integer, Lower, random_integer/3)
+    ),
+    ( integer(Upper) -> true
+    ; type_error(integer, Upper, random_integer/3)
+    ),
+    Lower < Upper,
+    random__current_seed(Seed0),
+    random(Seed0, _, Seed),
+    bb_put('$random_seed', Seed),
+    R is Lower + Seed mod (Upper - Lower).
+
+set_random(Seed) :-
+    ( var(Seed) -> instantiation_error(set_random/1)
+    ; Seed = seed(S) ->
+        ( var(S) -> instantiation_error(set_random/1)
+        ; integer(S) ->
+            random__random_normalize_seed(S, Normalized),
+            bb_put('$random_seed', Normalized)
+        ; type_error(integer, S, set_random/1)
+        )
+    ; type_error(random_state, Seed, set_random/1)
+    ).
+
+random__current_seed(Seed) :- bb_global_get('$random_seed', Seed), !.
+random__current_seed(1).
 
 % A Park-Miller generator with explicit state. Threading Seed into the next
 % call makes a sequence reproducible without mutable runtime state. Schrage's

package/src/lib/reif.pl

@@ -0,0 +1,94 @@
+/** Predicates from [*Indexing dif/2*](https://arxiv.org/abs/1607.01590).
+
+Example:
+
+```
+?- tfilter(=(a), [X,Y], Es).
+   X = a, Y = a, Es = "aa"
+;  X = a, Es = "a", dif:dif(a,Y)
+;  Y = a, Es = "a", dif:dif(a,X)
+;  Es = [], dif:dif(a,X), dif:dif(a,Y).
+```
+*/
+
+:- module(reif, [if_/3, (=)/3, (',')/3, (;)/3, cond_t/3, dif/3,
+		         memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
+		         tpartition/4]).
+
+:- use_module(library(dif)).
+
+:- meta_predicate(if_(1, 0, 0)).
+
+if_(If_1, Then_0, Else_0) :-
+    call(If_1, T),
+    (  T == true  -> call(Then_0)
+    ;  T == false -> call(Else_0)
+    ;  nonvar(T) -> throw(error(type_error(boolean, T), _))
+    ;  throw(error(instantiation_error, _))
+    ).
+
+=(X, Y, T) :-
+    (  X == Y -> T = true
+    ;  X \= Y -> T = false
+    ;  T = true, X = Y
+    ;  T = false, dif(X, Y)
+    ).
+
+dif(X, Y, T) :-
+  =(X, Y, NT),
+  non(NT, T).
+
+non(true, false).
+non(false, true).
+
+:- meta_predicate(tfilter(2, ?, ?)).
+
+tfilter(_, [], []).
+tfilter(C_2, [E|Es], Fs0) :-
+   if_(call(C_2, E), Fs0 = [E|Fs], Fs0 = Fs),
+   tfilter(C_2, Es, Fs).
+
+:- meta_predicate(tpartition(2, ?, ?, ?)).
+
+tpartition(P_2, Xs, Ts, Fs) :-
+   i_tpartition(Xs, P_2, Ts, Fs).
+
+i_tpartition([], _P_2, [], []).
+i_tpartition([X|Xs], P_2, Ts0, Fs0) :-
+   if_( call(P_2, X)
+      , ( Ts0 = [X|Ts], Fs0 = Fs )
+      , ( Fs0 = [X|Fs], Ts0 = Ts ) ),
+   i_tpartition(Xs, P_2, Ts, Fs).
+
+:- meta_predicate(','(1, 1, ?)).
+
+','(A_1, B_1, T) :-
+    if_(A_1, call(B_1, T), T = false).
+
+:- meta_predicate(';'(1, 1, ?)).
+
+';'(A_1, B_1, T) :-
+    if_(A_1, T = true, call(B_1, T)).
+
+:- meta_predicate(cond_t(1, 0, ?)).
+
+cond_t(If_1, Then_0, T) :-
+   if_(If_1, ( Then_0, T = true ), T = false ).
+
+memberd_t(E, Xs, T) :-
+   i_memberd_t(Xs, E, T).
+
+i_memberd_t([], _, false).
+i_memberd_t([X|Xs], E, T) :-
+   if_( X = E, T = true, i_memberd_t(Xs, E, T) ).
+
+:- meta_predicate(tmember(2, ?)).
+
+tmember(P_2, [X|Xs]) :-
+   if_( call(P_2, X), true, tmember(P_2, Xs) ).
+
+:- meta_predicate(tmember_t(2, ?, ?)).
+
+tmember_t(_P_2, [], false).
+tmember_t(P_2, [X|Xs], T) :-
+   if_( call(P_2, X), T = true, tmember_t(P_2, Xs, T) ).

package/src/lib/tabling.pl

@@ -0,0 +1,16 @@
+/** Common Scryer/Trealla tabling interface.
+
+    EyeProlog detects and tables recursive user predicates automatically.  The
+    explicit directive is therefore a source-compatible declaration, while
+    start_tabling/2 delegates to the already selected execution strategy.
+*/
+
+:- module(tabling, [start_tabling/2, abolish_all_tables/0, op(1150, fx, table)]).
+
+:- meta_predicate(start_tabling(?, 0)).
+
+start_tabling(_, Worker) :-
+    call(Worker).
+
+abolish_all_tables :-
+    eyeprolog__abolish_all_tables.

package/src/lib/time.pl

@@ -0,0 +1,26 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   format_time//2 is reused from the common Scryer/Trealla library(time),
+   written by Markus Triska.  Only current_time/1's platform adapter is
+   EyeProlog-specific.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+/** Predicates for reasoning about time. */
+
+:- module(time, [current_time/1, format_time//2]).
+
+:- use_module(library(dcgs), [seq//1]).
+:- use_module(library(error), [domain_error/3]).
+:- use_module(library(lists), [member/2]).
+
+current_time(T) :-
+    eyeprolog__current_time(T).
+
+format_time([], _) --> [].
+format_time(['%','%'|Fs], T) --> !, ['%'], format_time(Fs, T).
+format_time(['%',Spec|Fs], T) --> !,
+    (   { member(Spec=Value, T) } ->
+        seq(Value)
+    ;   { domain_error(time_specifier, Spec, format_time//2) }
+    ),
+    format_time(Fs, T).
+format_time([F|Fs], T) --> [F], format_time(Fs, T).