eyeprolog 1.3.78 → 1.3.80

package/src/lib/debug.pl

@@ -1,17 +1,43 @@
-/** Compatibility hooks for Scryer libraries.
+/** Compatibility hooks and declarative debugging.
 
-    CLP(Z) only needs the backtrackable blackboard operations; the debugging
-    predicates are deliberately harmless no-ops unless EyeProlog grows a debug
-    topic UI later.
+    The three operator predicates are reused from the identical Scryer and
+    Trealla library(debug) sources. The blackboard operations are retained for
+    the constraint libraries.
 */
 
-:- module(debug, [debug/1, debug/3, nodebug/1, bb_get/2, bb_b_put/2]).
+:- module(debug, [debug/1, debug/3, nodebug/1, bb_get/2, bb_put/2, bb_b_put/2,
+                  bb_global_get/2,
+                  op(900, fx, $), op(900, fx, $-), op(950, fy, *),
+                  (*)/1, ($)/1, ($-)/1]).
+
+:- op(900, fx, $).
+:- op(900, fx, $-).
+:- op(950, fy, *).
+
+:- use_module(library(format), [portray_clause/1]).
 
 :- meta_predicate(debug(+, +, +)).
+:- meta_predicate(*(0)).
+:- meta_predicate($(0)).
+:- meta_predicate($-(0)).
 
 debug(_).
 debug(_, _, _).
 nodebug(_).
 
-bb_get(Key, Value) :- eyeprolog__bb_get(Key, Value).
+$-(Goal) :-
+    catch(Goal, Exception,
+          ( portray_clause(exception:Exception:Goal), throw(Exception) )).
+
+$(Goal) :-
+    portray_clause(call:Goal),
+    $-Goal,
+    portray_clause(exit:Goal).
+
+*(_).
+
+bb_get(Key, Value) :- eyeprolog__bb_get(Key, Value), !.
+bb_get(Key, Value) :- eyeprolog__bb_global_get(Key, Value).
+bb_global_get(Key, Value) :- eyeprolog__bb_global_get(Key, Value).
+bb_put(Key, Value) :- eyeprolog__bb_global_put(Key, Value).
 bb_b_put(Key, Value) :- eyeprolog__bb_b_put(Key, Value).

package/src/lib/dif.pl

@@ -0,0 +1,7 @@
+/** Scryer/Trealla-compatible module facade for EyeProlog's native dif/2. */
+
+:- module(dif, [dif/2]).
+
+% dif/2 is supplied by the normal EyeProlog registry. Keeping this module
+% clause-free preserves that implementation while allowing the canonical
+% explicit import used by library(reif) and portable source.

package/src/lib/error.pl

@@ -61,14 +61,14 @@ error__must_be(Type, Term) :-
     ; type_error(Type, Term, must_be/2)
     ).
 
-error__proper_list([]).
+error__proper_list([]) :- !.
 error__proper_list([_|Tail]) :- !, error__proper_list(Tail).
 error__proper_list(Term) :-
     ( var(Term) -> instantiation_error(must_be/2)
     ; type_error(list, Term, must_be/2)
     ).
 
-error__proper_list_of([], _).
+error__proper_list_of([], _) :- !.
 error__proper_list_of([Head|Tail], Type) :- !,
     must_be(Type, Head),
     error__proper_list_of(Tail, Type).

package/src/lib/format.pl

@@ -1,35 +1,69 @@
-/** Small format/2 compatibility layer covering the controls used by CLP(Z). */
+/** Formatting relations shared with the Scryer/Trealla library interface. */
 
-:- module(format, [format/2]).
+:- module(format, [
+    format_//2,
+    format/2,
+    format/3,
+    portray_clause_//1,
+    portray_clause/1,
+    portray_clause/2,
+    listing/1
+]).
+
+:- use_module(library(dcgs), [seq//1]).
 
 format(Template, Arguments) :-
-    format__chars(Template, Chars),
-    format__emit(Chars, Arguments).
+    format(user_output, Template, Arguments).
+
+format(Stream, Template, Arguments) :-
+    phrase(format_(Template, Arguments), Chars),
+    format__put_chars(Chars, Stream).
+
+format_(Template, Arguments) -->
+    { format__chars(Template, Chars) },
+    format__dcg(Chars, Arguments).
 
 format__chars(Template, Chars) :-
     atom(Template), !,
     atom_chars(Template, Chars).
 format__chars(Chars, Chars).
 
-format__emit([], []).
-format__emit(['~','~'|Chars], Args) :- !,
-    put_char('~'),
-    format__emit(Chars, Args).
-format__emit(['~',n|Chars], Args) :- !,
-    nl,
-    format__emit(Chars, Args).
-format__emit(['~',w|Chars], [Arg|Args]) :- !,
-    write(Arg),
-    format__emit(Chars, Args).
-format__emit(['~',q|Chars], [Arg|Args]) :- !,
-    writeq(Arg),
-    format__emit(Chars, Args).
-format__emit(['~',a|Chars], [Arg|Args]) :- !,
-    write(Arg),
-    format__emit(Chars, Args).
-format__emit(['~',d|Chars], [Arg|Args]) :- !,
-    write(Arg),
-    format__emit(Chars, Args).
-format__emit([Char|Chars], Args) :-
-    put_char(Char),
-    format__emit(Chars, Args).
+format__dcg([], []) --> [].
+format__dcg(['~','~'|Chars], Args) --> !, ['~'], format__dcg(Chars, Args).
+format__dcg(['~',n|Chars], Args) --> !, ['\n'], format__dcg(Chars, Args).
+format__dcg(['~',Control|Chars], [Arg|Args]) -->
+    { format__term_control(Control),
+      eyeprolog__term_chars(Control, Arg, Text)
+    }, !,
+    seq(Text),
+    format__dcg(Chars, Args).
+format__dcg([Char|Chars], Args) --> [Char], format__dcg(Chars, Args).
+
+format__term_control(w).
+format__term_control(q).
+format__term_control(a).
+format__term_control(d).
+
+portray_clause_(Clause) -->
+    { eyeprolog__term_chars(q, Clause, Chars) },
+    seq(Chars), ['.','\n'].
+
+portray_clause(Clause) :-
+    portray_clause(user_output, Clause).
+
+portray_clause(Stream, Clause) :-
+    phrase(portray_clause_(Clause), Chars),
+    format__put_chars(Chars, Stream).
+
+listing(Name/Arity) :-
+    functor(Head, Name, Arity),
+    ( clause(Head, Body),
+      portray_clause((Head :- Body)),
+      fail
+    ; true
+    ).
+
+format__put_chars([], _).
+format__put_chars([Char|Chars], Stream) :-
+    put_char(Stream, Char),
+    format__put_chars(Chars, Stream).

package/src/lib/gensym.pl

@@ -0,0 +1,33 @@
+:- module(gensym, [gensym/2,
+		   reset_gensym/1]).
+
+:- use_module(library(error)).
+:- use_module(library(lists)).
+:- use_module(library(iso_ext)).
+:- use_module(library(si)).
+:- use_module(library(debug), [bb_global_get/2, bb_put/2]).
+
+gensym_key(Base, BaseKey) :-
+    atom_concat('gensym_', Base, BaseKey).
+
+append_id(Base, UniqueID, Unique) :-
+    atom_chars(Base, BaseChars),
+    number_chars(UniqueID, IDChars),
+    append(BaseChars, IDChars, AtomChars),
+    atom_chars(Unique, AtomChars).
+
+gensym(Base, Unique) :-
+    must_be(var, Unique),
+    atom_si(Base),
+    gensym_key(Base, BaseKey),
+    (  bb_global_get(BaseKey, UniqueID0) -> true
+    ;  UniqueID0 = 0
+    ),
+    UniqueID is UniqueID0 + 1,
+    append_id(Base, UniqueID, Unique),
+    bb_put(BaseKey, UniqueID).
+
+reset_gensym(Base) :-
+    atom_si(Base),
+    gensym_key(Base, BaseKey),
+    bb_put(BaseKey, 0).

package/src/lib/lists.pl

@@ -24,10 +24,14 @@
     foldl/4,
     foldl/5,
     foldl/6,
+    transpose/2,
     sum_list/2,
+    list_max/2,
+    list_min/2,
     min_list/2,
     max_list/2,
     list_to_set/2,
+    permutation/2,
     set_nth0/4,
     take/3,
     drop/3,
@@ -165,14 +169,40 @@ foldl(Closure, [A|As], [B|Bs], [C|Cs], Acc0, Acc) :-
     call(Closure, A, B, C, Acc0, Acc1),
     foldl(Closure, As, Bs, Cs, Acc1, Acc).
 
+transpose([], []).
+transpose([[]|Rows], []) :- lists__all_empty(Rows).
+transpose([[X|Xs]|Rows], [[X|Heads]|Columns]) :-
+    maplist(lists__list_first_rest, Rows, Heads, Tails),
+    transpose([Xs|Tails], Columns).
+
+lists__all_empty([]).
+lists__all_empty([[]|Rows]) :- lists__all_empty(Rows).
+
+lists__list_first_rest([X|Xs], X, Xs).
+
 sum_list(List, Sum) :- lists__sum_list(List, 0, Sum).
 
+list_max([X|Xs], Max) :- foldl(lists__list_max, Xs, X, Max).
+lists__list_max(X, Max0, Max) :- Max is max(X, Max0).
+
+list_min([X|Xs], Min) :- foldl(lists__list_min, Xs, X, Min).
+lists__list_min(X, Min0, Min) :- Min is min(X, Min0).
+
 min_list([X|Xs], Min) :- lists__min_list(Xs, X, Min).
 
 max_list([X|Xs], Max) :- lists__max_list(Xs, X, Max).
 
 list_to_set(List, Set) :- lists__list_to_set(List, [], Set).
 
+permutation(Xs, Ys) :-
+    same_length(Xs, Ys),
+    lists__permutation(Xs, Ys).
+
+lists__permutation([], []).
+lists__permutation(List, [First|Perm]) :-
+    select(First, List, Rest),
+    lists__permutation(Rest, Perm).
+
 
 set_nth0(0, [_|Xs], X, [X|Xs]).
 set_nth0(N, [Y|Ys], X, [Y|Zs]) :-