remove vestigial prolog/ directory (#444)

src/examples/domain.pl

@@ -0,0 +1,51 @@
+/* From the SICSTUS Prolog documentation at:
+https://sicstus.sics.se/sicstus/docs/3.7.1/html/sicstus_17.html
+*/
+
+:- module(domain, [domain/2]).
+
+:- use_module(library(atts)).
+:- use_module(library(ordsets), [
+        ord_intersection/3,
+        ord_intersect/2,
+        list_to_ord_set/2
+   ]).
+
+:- attribute dom/1.
+
+verify_attributes(Var, Other, Goals) :-
+        get_atts(Var, dom(Da)), !,          % are we involved?
+        (   var(Other) ->                   % must be attributed then
+            (   get_atts(Other, dom(Db)) -> %   has a domain?
+                ord_intersection(Da, Db, Dc),
+                Dc = [El|Els],              % at least one element
+                (   Els = [] ->             % exactly one element
+                    Goals = [Other=El]      % implied binding
+                ;   Goals = [],
+                    put_atts(Other, dom(Dc))% rescue intersection
+                )
+            ;   Goals = [],
+                put_atts(Other, dom(Da))    % rescue the domain
+            )
+        ;   Goals = [],
+            ord_intersect([Other], Da)      % value in domain?
+        ).
+verify_attributes(_, _, []).                % unification triggered
+                                            % because of attributes
+                                            % in other modules
+
+attribute_goals(Var, domain(Var,Dom)) :-     % interpretation as goal
+        get_atts(Var, dom(Dom)).
+
+domain(X, Dom) :-
+        var(Dom), !,
+        get_atts(X, dom(Dom)).
+domain(X, List) :-
+        list_to_ord_set(List, Set),
+        Set = [El|Els],                     % at least one element
+        (   Els = [] ->                     % exactly one element
+            X = El                          % implied binding
+        ;   put_atts(Fresh, dom(Set)),
+            X = Fresh                       % may call
+                                            % verify_attributes/3
+        ).

src/examples/echo_server.pl

@@ -0,0 +1,31 @@
+:- module(echo_server, [echo_server/0,
+                        echo_server/1]).
+
+:- use_module(library(format)).
+:- use_module(library(sockets)).
+
+
+echo_server :-
+    echo_server('127.0.0.1').
+
+
+echo_server(Addr) :-
+    socket_server_open(Addr:Port, ServerSocket),
+    format("echo_server: connection opened at ~w:~d~n", [Addr, Port]),
+    socket_server_accept(ServerSocket, Client, Stream, [eof_action(eof_code)]),
+    format("echo_server: connection accepted from ~a~n", [Client]),
+    !,
+    echo_loop(Stream),
+    socket_server_close(ServerSocket).
+
+
+echo_loop(Stream) :-
+    read_term(Stream, Term, []),
+    (  Term == end_of_file ->
+       true
+    ;
+       format("received: ~w~n", [Term]),
+       !,
+       echo_loop(Stream)
+    ).
+

src/examples/expert_system.pl

@@ -0,0 +1,42 @@
+:- use_module(library(dcgs)).
+:- use_module(library(reif)).
+
+animals([animal(dog, [is_true('has fur'), is_true('says woof')]),
+         animal(cat, [is_true('has fur'), is_true('says meow')]),
+         animal(duck, [is_true('has feathers'), is_true('says quack')])]).
+
+animal(A) :-
+    animals(Animals),
+    Known0 = [],
+    phrase(any_animal(Animals, A), [Known0], _).
+
+any_animal([Animal|Animals], A) -->
+    any_animal_(Animal, Animals, A).
+
+any_animal_(animal(A0, []), Animals, A) -->
+    (   { A0 = A }
+    ;   any_animal(Animals, A)
+    ).
+any_animal_(animal(A0, [C|Cs]), Animals, A) -->
+    state0_state(Known0, Known),
+    { condition_truth(C, T, Known0, Known) },
+    next_animal(T, animal(A0,Cs), Animals, A).
+
+next_animal(yes, Animal, Animals, A)  --> any_animal([Animal|Animals], A).
+next_animal(no, _, Animals, A)        --> any_animal(Animals, A).
+
+state0_state(S0, S), [S] --> [S0].
+
+condition_truth(is_true(Q), Answer, Known0, Known) :-
+    if_(known_(Q,Answer,Known0),
+        Known0 = Known,
+        ( writeq([Q, ?]), nl,
+	  read(Answer),
+          Known = [known(Q,Answer)|Known0])).
+
+known_(What, Answer, Known, Truth) :-
+    if_(memberd_t(known(What,yes), Known),
+        ( Answer = yes, Truth = true ),
+        if_(memberd_t(known(What,no), Known),
+            ( Answer = no, Truth = true),
+            Truth = false)).

src/examples/least_time.pl

@@ -0,0 +1,57 @@
+/*  least_time.pl
+ *
+ *  By Mark Thom, 2020
+ *
+ *  find_min_time/2 solves a problem sometimes posed in the first round
+ *  of Google interviews: given a time of day in 24 H format, what is the
+ *  lexicographically least permutation of the time that is itself a
+ *  valid time in 24 H format?
+ *
+ *  Full generality is achieved using the reif library.
+ */
+
+:- module(least_time, [find_min_time/2,
+		               write_time_nl/1]).
+
+
+:- use_module(library(dcgs)).
+:- use_module(library(format)).
+:- use_module(library(lists)).
+:- use_module(library(reif)).
+
+
+permutation([], []).
+permutation([X|Xs], Ys) :-
+    permutation(Xs, Yss),
+    select(X, Ys, Yss).
+
+
+valid_time([H1,H2,M1,M2], T) :-
+    memberd_t(H1, [0,1,2], TH1),
+    memberd_t(H2, [0,1,2,3,4,5,6,7,8,9], TH2),
+    memberd_t(M1, [0,1,2,3,4,5], TM1),
+    memberd_t(M2, [0,1,2,3,4,5,6,7,8,9], TM2),
+    (  maplist(=(true), [TH1, TH2, TM1, TM2]) ->
+       (  H1 =:= 2 ->
+	      (  H2 =< 3 ->
+	         T = true
+	      ;  T = false
+	      )
+       ;  T = true
+       )
+    ;  T = false
+    ).
+
+
+permuted_times(Time, PermutedTimes) :-
+    setof(P, permutation(Time, P), PermutedTimes0),
+    tfilter(valid_time, PermutedTimes0, PermutedTimes).
+
+
+find_min_time(Time, Min) :-
+    valid_time(Time, true),
+    permuted_times(Time, [Min|_]).
+
+
+write_time_nl(Time) :-
+    format("\"~w~w:~w~w\"~n", Time).

src/examples/minatotask.pl

@@ -0,0 +1,112 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   SICStus implementation of the Minato task.
+   Written Sept. 2017 by Markus Triska (triska@metalevel.at)
+   Public domain code.
+
+   For more information, please see:
+
+   https://www.metalevel.at/prolog/attributedvariables
+   ===================================================
+
+   A ZDD node is either:
+
+       -) a *leaf* of the form b(true) or b(false)
+       -) an *inner node* of the form ( Var -> Then ; Else ).
+
+   In ZDDs, variables that are *not* encountered on a path to TRUE
+   must be 0.
+
+   This module exports a single predicate:
+
+   * variables_set_zdd(Vs, ZDD)
+
+   It associates each variable in Vs with the given ZDD. For each
+   variable, the ZDD is stored as an attribute zdd_vs(ZDD, Vs).  This
+   lets us reason about all variables that originally occurred.
+
+   The internal unification hooks must be implemented so that only
+   admissible assignments of truth variables to variables succeed.
+
+   In particular, the Minato task:
+
+   ?- ZDD = ( X -> b(true) ; ( Y -> b(true) ; b(false) ) ),
+      Vs = [X,Y],
+      variables_set_zdd(Vs, ZDD),
+      Vs = [1,1].
+
+           no
+
+   Other examples:
+
+   ?- ZDD = ( X -> b(true) ; ( Y -> b(true) ; b(false) ) ),
+      Vs = [X,Y],
+      variables_set_zdd(Vs, ZDD),
+      X = 1.
+
+           X = 1,
+           Y = 0,
+           Vs = [1,0] ? ;
+
+
+   ?- ZDD = ( X -> b(true) ; ( Y -> b(true) ; b(false) ) ),
+      Vs = [X,Y],
+      variables_set_zdd(Vs, ZDD),
+      X = 0.
+
+           X = 0,
+           Vs = [0,Y] ? ;
+
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- module(zdd, [variables_set_zdd/2]).
+
+:- use_module(library(atts)).
+:- use_module(library(dcgs)).
+:- use_module(library(lists)).
+
+:- attribute zdd_vs/2.
+
+variables_set_zdd(Vs, ZDD) :-
+        maplist(set_zdd(ZDD, Vs), Vs).
+
+set_zdd(ZDD, Vs, V) :-
+        put_atts(V, +zdd_vs(ZDD, Vs)).
+
+
+verify_attributes(Var, Value, Goals) :-
+        (   get_atts(Var, +zdd_vs(ZDD0,Vs)) ->
+            (   integer(Value) ->
+                zdd_restriction(ZDD0, Var, Value, ZDD)
+            ;   throw(aliasing_not_implemented)
+            ),
+            phrase(remaining_vars_0(ZDD, Var, Vs), Goals)
+        ;   Goals = []
+        ).
+
+remaining_vars_0(b(true), Var, Vs) --> all_others_0(Vs, Var).
+remaining_vars_0((_;_), _, _) --> [].
+
+all_others_0([], _) --> [].
+all_others_0([V|Vs], Var) -->
+        (   { var(V), V \== Var } -> [V=0]
+        ;   []
+        ),
+        all_others_0(Vs, Var).
+
+
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Compute the *restriction* of the ZDD.
+   This means that Var has been instantiated to Value.
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+zdd_restriction(b(T), _, _, b(T)).
+zdd_restriction(( Var0 -> Then0 ; Else0), Var, Value, ZDD) :-
+        (   Var0 == Var ->
+            (   Value =:= 0 -> ZDD = Else0
+            ;   Value =:= 1 -> ZDD = Then0
+            ;   throw(no_boolean)
+            )
+        ;   zdd_restriction(Then0, Var, Value, Then),
+            zdd_restriction(Else0, Var, Value, Else),
+            ZDD = ( Var0 -> Then ; Else )
+        ).

src/examples/plres.pl

@@ -0,0 +1,55 @@
+/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+   Written by Markus Triska, triska@metalevel.at, Sept. 5th 2006
+   Public domain code.
+   ----------------------------------------------------------------------
+
+   Resolution calculus for propositional logic.
+
+   For more information about theorem proving with Prolog, see:
+
+   https://www.metalevel.at/prolog/theoremproving
+   ==============================================
+
+   Input is a formula in conjunctive normal form, represented as a
+   list of clauses; clauses are lists of atoms and terms not/1.
+
+   Example:
+
+   ?- Clauses = [[p,not(q)], [not(p),not(s)], [s,not(q)], [q]],
+      pl_resolution(Clauses, Rs),
+      maplist(portray_clause, Rs).
+   %@ [p, not(q)]-[not(p), not(s)] -->
+   %@   [not(q), not(s)].
+   %@ [s, not(q)]-[not(q), not(s)] -->
+   %@   [not(q)].
+   %@ [q]-[not(q)] -->
+   %@   [].
+
+   Iterative deepening is used to find a shortest refutation.
+
+- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+
+:- use_module(library(dcgs)).
+:- use_module(library(dif)).
+:- use_module(library(format)).
+:- use_module(library(lists)).
+
+pl_resolution(Clauses0, Chain) :-
+        maplist(sort, Clauses0, Clauses), % remove duplicates
+        length(Chain, _),
+        pl_derive_empty_clause(Chain, Clauses).
+
+pl_derive_empty_clause([], Clauses) :-
+        member([], Clauses).
+pl_derive_empty_clause([C|Cs], Clauses) :-
+        pl_resolvent(C, Clauses, Rs),
+        pl_derive_empty_clause(Cs, [Rs|Clauses]).
+
+pl_resolvent(((As0-Bs0) --> Rs), Clauses, Rs) :-
+        member(As0, Clauses),
+        member(Bs0, Clauses),
+        select(Q, As0, As),
+        select(not(Q), Bs0, Bs),
+        append(As, Bs, Rs0),
+        sort(Rs0, Rs), % remove duplicates
+        maplist(dif(Rs), Clauses).

src/examples/utf8.pl

@@ -0,0 +1,31 @@
+:- use_module(library(charsio)).
+:- use_module(library(lists)).
+
+:- initialization(unit_test).
+
+unit_test :-
+  chars_utf8bytes("a£\x2124\", Bs),
+  Bs = [97, 194, 163, 226, 132, 164],
+  chars_utf8bytes(Cs, Bs),
+  Cs = "a£\x2124\".
+
+write_f :-
+  open('x.txt', write, Stream, [type(binary)]),
+  F = put_byte(Stream),
+  chars_utf8bytes("£\x2124\\x2764\\x1F496\\n", Bs),
+  maplist(F, Bs),
+  close(Stream).
+
+get_bytes(Stream, Res) :- get_bytes(Stream, [], Res).
+get_bytes(Stream, Acc, Res) :-
+  get_byte(Stream, B),
+  (B =:= -1 ->
+    reverse(Acc, Res)
+  ; get_bytes(Stream, [B|Acc], Res)).
+
+read_f :-
+  open('x.txt', read, Stream, [type(binary)]),
+  get_bytes(Stream, Bs),
+  chars_utf8bytes(Cs, Bs),
+  write(Cs),
+  close(Stream).