rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into docs-builtins

Browse Source
This commit is contained in:
Adrián Arroyo Calle
2022-12-21 21:29:22 +01:00
committed by GitHub
parent 56c1c4e43c 820011412b
commit f2d041ea23
18 changed files with 924 additions and 669 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
src/lib/arithmetic.pl
View File

@@ -1,4 +1,4 @@
:- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
:- module(arithmetic, [expmod/4, lcm/3, lsb/2, msb/2, number_to_rational/2,
number_to_rational/3, popcount/2,
rational_numerator_denominator/3]).
@@ -28,6 +28,22 @@ expmod_(Base0, Expo0, Mod, C, R) :-
Base is (Base0 * Base0) mod Mod,
expmod_(Base, Expo, Mod, C, R).
%% lcm(+A, +B, -Lcm) is det.
%
% Calculates the Least common multiple for A and B: the smallest positive integer
% that is divisible by both A and B.
%
% A and B need to be integers.
lcm(A, B, X) :-
builtins:must_be_number(A, lcm/2),
builtins:must_be_number(B, lcm/2),
( \+ integer(A) -> type_error(integer, A, lcm/2)
; \+ integer(B) -> type_error(integer, B, lcm/2)
; (A = 0, B = 0) -> X = 0
; builtins:can_be_number(X, lcm/2),
X is abs(B) // gcd(A,B) * abs(A)
).
lsb(X, N) :-
builtins:must_be_number(X, lsb/2),
( \+ integer(X) -> type_error(integer, X, lsb/2)

95
src/lib/builtins.pl
View File

@@ -256,9 +256,8 @@ G1 -> G2 :- control_entry_point((G1 -> G2)).
:- non_counted_backtracking staggered_if_then/2.
staggered_if_then(G1, G2) :-
'$get_staggered_cp'(B),
call(G1),
'$set_cp'(B),
!,
call(G2).
%% ;(G1, G2)
@@ -269,7 +268,14 @@ G1 ; G2 :- control_entry_point((G1 ; G2)).
:- non_counted_backtracking staggered_sc/2.
staggered_sc(G, _) :- call(G).
staggered_sc(G, _) :-
( nonvar(G),
G = '$call'(builtins:staggered_if_then(G1, G2)) ->
call(G1),
!,
call(G2)
; call(G)
).
staggered_sc(_, G) :- call(G).
%% !.
@@ -288,6 +294,7 @@ set_cp(B) :- '$set_cp'(B).
% Conjuction (and)
','(G1, G2) :- control_entry_point((G1, G2)).
:- non_counted_backtracking control_entry_point/1.
control_entry_point(G) :-
@@ -311,47 +318,15 @@ cont_list_goal([Cont], Cont) :- !.
cont_list_goal(Conts, '$call'(builtins:dispatch_call_list(Conts))).
:- non_counted_backtracking module_qualified_cut/1.
module_qualified_cut(Gs) :-
( functor(Gs, call, 1) ->
arg(1, Gs, G1)
; Gs = G1
),
functor(G1, (:), 2),
arg(2, G1, G2),
G2 == !.
:- non_counted_backtracking dispatch_prep/3.
dispatch_prep(Gs, B, [Cont|Conts]) :-
( callable(Gs) ->
( functor(Gs, ',', 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
dispatch_prep(G1, B, IConts1),
cont_list_goal(IConts1, Cont),
dispatch_prep(G2, B, Conts)
; functor(Gs, ';', 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
dispatch_prep(G1, B, IConts0),
dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1),
Cont = '$call'(builtins:staggered_sc(Cont0, Cont1)),
Conts = []
; functor(Gs, ->, 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
dispatch_prep(G1, B, IConts1),
dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2),
Cont = '$call'(builtins:staggered_if_then(Cont1, Cont2)),
Conts = []
; ( Gs == ! ; module_qualified_cut(Gs) ) ->
strip_module(Gs, M, Gs0),
( nonvar(Gs0),
dispatch_prep_(Gs0, B, [Cont|Conts]) ->
true
; Gs0 == ! ->
Cont = '$call'(builtins:set_cp(B)),
Conts = []
; Cont = Gs,
@@ -364,6 +339,28 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
).
:- non_counted_backtracking dispatch_prep_/3.
dispatch_prep_((G1, G2), B, [Cont|Conts]) :-
dispatch_prep(G1, B, IConts1),
cont_list_goal(IConts1, Cont),
dispatch_prep(G2, B, Conts).
dispatch_prep_((G1 ; G2), B, [Cont|Conts]) :-
dispatch_prep(G1, B, IConts0),
dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1),
Cont = '$call'(builtins:staggered_sc(Cont0, Cont1)),
Conts = [].
dispatch_prep_((G1 -> G2), B, [Cont|Conts]) :-
dispatch_prep(G1, B, IConts1),
dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2),
Cont = '$call'(builtins:staggered_if_then(Cont1, Cont2)),
Conts = [].
:- non_counted_backtracking dispatch_call_list/1.
dispatch_call_list([]).
@@ -960,11 +957,10 @@ findall_with_existential(Template, Goal, PairedSolutions, Witnesses0, Witnesses)
% Bag = [1,2].
bagof(Template, Goal, Solution) :-
error:can_be(list, Solution),
term_variables(Template, TemplateVars0),
term_variables(Goal, GoalVars0),
sort(TemplateVars0, TemplateVars),
sort(GoalVars0, GoalVars),
set_difference(GoalVars, TemplateVars, Witnesses0),
term_variables(Template, TemplateVars),
term_variables(Goal, GoalVars),
term_variables(TemplateVars+GoalVars, TGVs),
lists:append(TemplateVars, Witnesses0, TGVs),
findall_with_existential(Template, Goal, PairedSolutions0, Witnesses0, Witnesses),
keysort(PairedSolutions0, PairedSolutions),
group_by_variants(PairedSolutions, GroupedSolutions),
@@ -997,11 +993,10 @@ iterate_variants_and_sort([_|GroupSolutions], Ws, Solution) :-
% Set = [1, 2].
setof(Template, Goal, Solution) :-
error:can_be(list, Solution),
term_variables(Template, TemplateVars0),
term_variables(Goal, GoalVars0),
sort(TemplateVars0, TemplateVars),
sort(GoalVars0, GoalVars),
set_difference(GoalVars, TemplateVars, Witnesses0),
term_variables(Template, TemplateVars),
term_variables(Goal, GoalVars),
term_variables(TemplateVars+GoalVars, TGVs),
lists:append(TemplateVars, Witnesses0, TGVs),
findall_with_existential(Template, Goal, PairedSolutions0, Witnesses0, Witnesses),
keysort(PairedSolutions0, PairedSolutions),
group_by_variants(PairedSolutions, GroupedSolutions),

160
src/lib/files.pl
View File

@@ -1,3 +1,22 @@
/** Predicates for reasoning about files and directories.
In this library, directories and files are represented as
*lists of characters*. This is an ideal representation:
* Lists of characters can be conveniently reasoned about with DCGs
and built-in Prolog predicates from library(lists). This alone
is already a very compelling argument to use them.
* Other Scryer libraries such as library(http/http_open) also already
use lists of characters to represent paths.
* File names are mostly ephemeral, so it is good for efficiency
that they can quickly allocated transiently on the heap, leaving the
atom table mostly unaffected. Indexing is almost never needed
for file names. If needed, it should be added to the engine.
* The previous point is also good for security, since the system
leaves little trace of which files were even accessed.
* Scryer Prolog represents lists of characters extremely compactly.
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2020, 2022 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
@@ -51,8 +70,9 @@
file_exists/1,
directory_exists/1,
delete_file/1,
rename_file/2,
delete_directory/1,
rename_file/2,
file_copy/2,
delete_directory/1,
make_directory/1,
make_directory_path/1,
working_directory/2,
@@ -67,41 +87,82 @@
:- use_module(library(charsio)).
:- use_module(library(dcgs)).
%% directory_files(+Directory, -Files).
%
% Returns the list of files *and* directories available at a specific
% directory in the current system.
directory_files(Directory, Files) :-
must_be(chars, Directory),
can_be(list, Files),
'$directory_files'(Directory, Files).
%% file_size(+File, -Size).
%
% Returns the size (in bytes) of a file. The file must exist.
file_size(File, Size) :-
file_must_exist(File, file_size/2),
can_be(integer, Size),
'$file_size'(File, Size).
%% file_exists(+File).
%
% Succeeds if File is a file that exists in the current system.
file_exists(File) :-
must_be(chars, File),
'$file_exists'(File).
%% directory_exists(+Directory).
%
% Succeeds if Directory is a directory that exists in the current system.
directory_exists(Directory) :-
must_be(chars, Directory),
'$directory_exists'(Directory).
%% make_directory(+Directory).
%
% Succeeds if it creates a new directory named Directory in the current system.
% If you want to create a nested directory, use make\_directory\_path/1.
make_directory(Directory) :-
must_be(chars, Directory),
'$make_directory'(Directory).
%% make_directory_path(+Directory).
%
% Similar to make\_directory/1 but recursively creates directories if they're missing.
% Equivalent to mkdir -p in Unix.
make_directory_path(Directory) :-
must_be(chars, Directory),
'$make_directory_path'(Directory).
%% delete_file(+File).
%
% Succeeds if deletes File from the current system.
delete_file(File) :-
file_must_exist(File, delete_file/1),
'$delete_file'(File).
%% rename_file(+File, +Renamed).
%
% Succeeds if File is renamed to Renamed
rename_file(File, Renamed) :-
file_must_exist(File, rename_file/2),
must_be(chars, Renamed),
'$rename_file'(File, Renamed).
%% file_copy(+File, +Copied).
%
% Succeeds if File is copied to Copied
file_copy(File, Copied) :-
file_must_exist(File, file_copy/2),
must_be(chars, Copied),
'$file_copy'(File, Copied).
%% delete_directory(+Directory).
%
% Succeeds if Directory is deleted from the current system.
% Directory must be empty.
delete_directory(Directory) :-
directory_must_exist(Directory, delete_directory/1),
must_be(chars, Directory),
@@ -117,31 +178,31 @@ directory_must_exist(Directory, Context) :-
; throw(error(existence_error(directory, Directory), Context))
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Dir0 is the current working directory, and the working directory
is changed to Dir.
%% workind_directory(Dir0, Dir).
%
% Dir0 is the current working directory, and the working directory
% is changed to Dir.
Use working_directory(Ds, Ds) to determine the current working directory,
and leave it as is.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
% Use `working\_directory(Ds, Ds)` to determine the current working directory,
% and leave it as is.
working_directory(Dir0, Dir) :-
can_be(list, Dir0),
can_be(list, Dir),
'$working_directory'(Dir0, Dir).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
True iff Cs is the canonical, absolute path of Ps.
All intermediate components are normalized, and all symbolic links
are resolved.
The predicate fails in the following situations, though not
necessarily *only* in these cases:
1. Ps is a path that does not exist.
2. A non-final component in Ps is not a directory.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% path_canonical(Ps, Cs).
%
% True iff Cs is the canonical, absolute path of Ps.
%
% All intermediate components are normalized, and all symbolic links
% are resolved.
%
% The predicate fails in the following situations, though not
% necessarily *only* in these cases:
%
% 1. Ps is a path that does not exist.
% 2. A non-final component in Ps is not a directory.
path_canonical(Ps, Cs) :-
must_be(chars, Ps),
@@ -155,12 +216,27 @@ path_canonical(Ps, Cs) :-
For two time stamps A and B, if A precedes B, then A @< B holds.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% file_modification_time(+File, -T).
%
% For a file File that must exist, it returns a time stamp T with the modification time
%
% T is a time stamp compatible with library(time).
file_modification_time(File, T) :-
file_time_(File, modification, T).
%% file_access_time(+File, -T).
%
% For a file File that must exist, it returns a time stamp T with the access time
%
% T is a time stamp compatible with library(time).
file_access_time(File, T) :-
file_time_(File, access, T).
%% file_creation_time(+File, -T).
%
% For a file File that must exist, it returns a time stamp T with the creation time
%
% T is a time stamp compatible with library(time).
file_creation_time(File, T) :-
file_time_(File, creation, T).
@@ -170,29 +246,27 @@ file_time_(File, Which, T) :-
read_from_chars(T0, T).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
path_segments(Ps, Segments): True iff Segments are the segments of Ps.
Segments is the list of components of the path Ps that are
separated by the platform-specific directory separator. Each
segment is a list of characters.
At least one of the arguments must be instantiated.
Examples:
?- path_segments("/hello/there", Segments).
Segments = [[],"hello","there"].
?- path_segments(Path, ["hello","there"]).
Path = "hello/there".
To obtain the platform-specific directory separator, you can use:
?- path_segments(Separator, ["",""]).
Separator = "/".
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% path_segments(Ps, Segments).
%
% True iff Segments are the segments of Ps.
%
% Segments is the list of components of the path Ps that are
% separated by the platform-specific directory separator. Each
% segment is a list of characters.
%
% At least one of the arguments must be instantiated.
%
% Examples:
%
% ?- path_segments("/hello/there", Segments).
% Segments = [[],"hello","there"].
% ?- path_segments(Path, ["hello","there"]).
% Path = "hello/there".
%
% To obtain the platform-specific directory separator, you can use:
%
% ?- path_segments(Separator, ["",""]).
% Separator = "/".
path_segments(Path, Segments) :-
'$directory_separator'(Sep),

47
src/lib/http/http_open.pl
View File

@@ -1,34 +1,37 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2022 by Adrián Arroyo Calle (adrian.arroyocalle@gmail.com)
Part of Scryer Prolog.
*/
http_open(+Address, -Stream, +Options)
======================================
/** Make HTTP requests.
Yields Stream to read the body of an HTTP reply from Address.
Address is a list of characters, and includes the method. Both HTTP
and HTTPS are supported.
Options supported:
* method(+Method): Sets the HTTP method of the call. Method can be get (default), head, delete, post, put or patch.
* data(+Data): Data to be sent in the request. Useful for POST, PUT and PATCH operations.
* size(-Size): Unifies with the value of the Content-Length header
* request_headers(+RequestHeaders): Headers to be used in the request
* headers(-ListHeaders): Unifies with a list with all headers returned in the response
* status_code(-Code): Unifies with the status code of the request (200, 201, 404, ...)
Example:
?- http_open("https://github.com/mthom/scryer-prolog", S, []).
%@ S = '$stream'(0x7fcfc9e00f00).
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
This library contains the predicate http\_open/3 which allows you to perform HTTP(S) calls.
Useful for making API calls, or parsing websites. It uses Hyper underneath.
*/
:- module(http_open, [http_open/3]).
:- use_module(library(lists)).
%% http_open(+Address, -Stream, +Options).
%
% Yields Stream to read the body of an HTTP reply from Address.
% Address is a list of characters, and includes the method. Both HTTP
% and HTTPS are supported.
%
% Options supported:
%
% * `method(+Method)`: Sets the HTTP method of the call. Method can be `get` (default), `head`, `delete`, `post`, `put` or `patch`.
% * `data(+Data)`: Data to be sent in the request. Useful for POST, PUT and PATCH operations.
% * `size(-Size)`: Unifies with the value of the Content-Length header
% * `request_headers(+RequestHeaders)`: Headers to be used in the request
% * `headers(-ListHeaders)`: Unifies with a list with all headers returned in the response
% * `status_code(-Code)`: Unifies with the status code of the request (200, 201, 404, ...)
%
% Example:
%
% ?- http_open("https://www.example.com", S, []), get_n_chars(S, N, HTML).
% S = '$stream'(0x7fb548001be8), N = 1256, HTML = "<!doctype html>\n<ht ...".
http_open(Address, Response, Options) :-
parse_http_options(Options, OptionValues),
( member(method(Method), OptionValues) -> true; Method = get),
@@ -65,4 +68,4 @@ parse_http_options_(request_headers(Headers), request_headers(Headers)) :-
parse_http_options_(size(Size), size(Size)).
parse_http_options_(status_code(Code), status_code(Code)).
parse_http_options_(headers(Headers), headers(Headers)).
parse_http_options_(headers(Headers), headers(Headers)).

94
src/lib/iso_ext.pl
View File

@@ -1,3 +1,9 @@
/** Useful general predicates that are not ISO standard yet
Predicates available here are similar to the ones defined in builtin.pl,
but they're not part of the ISO Prolog standard at the moment.
*/
:- module(iso_ext, [bb_b_put/2,
bb_get/2,
bb_put/2,
@@ -22,25 +28,70 @@
:- meta_predicate(forall(0, 0)).
%% forall(Generate, Test).
%
% For all bindings possible by Generate, Test must be true.
%
% In this example, it checks that all numbers are even:
%
% ?- Ns = [2,4,6], forall(member(N, Ns), 0 is N mod 2).
% Ns = [2,4,6].
forall(Generate, Test) :-
\+ (Generate, \+ Test).
%% (non-)backtrackable global variables.
% (non-)backtrackable global variables.
%% bb_put(+Key, +Value).
%
% Sets a global variable named Key (must be an atom) with value Value.
% The global variable isn't backtrackable. Check bb\_b\_put/2 for the
% backtrackable version.
%
% ?- bb_put(city, "Valladolid").
% true.
% ?- bb_get(city, X).
% X = "Valladolid".
% In this example one can understand the difference between bb\_put/2 and
% bb\_b\_put/2:
%
% ?- bb_put(city, "Valladolid"), (bb_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Salamanca".
% ?- bb_put(city, "Valladolid"), (bb_b_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Valladolid".
bb_put(Key, Value) :-
( atom(Key) ->
'$store_global_var'(Key, Value)
; type_error(atom, Key, bb_put/2)
).
%% backtrackable global variables.
% backtrackable global variables.
%% bb_b_put(+Key, +Value).
%
% Sets a global variable named Key (must be an atom) with value Value.
% The global variable is backtrackable. Check bb\_put/2 for the
% non-backtrackable version.
%
% ?- bb_b_put(city, "Valladolid").
% true.
% ?- bb_get(city, X).
% X = "Valladolid".
% In this example one can understand the difference between bb\_put/2 and
% bb\_b\_put/2:
%
% ?- bb_put(city, "Valladolid"), (bb_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Salamanca".
% ?- bb_put(city, "Valladolid"), (bb_b_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Valladolid".
bb_b_put(Key, Value) :-
( atom(Key) ->
'$store_backtrackable_global_var'(Key, Value)
; type_error(atom, Key, bb_b_put/2)
).
%% bb_get(+Key, -Value).
%
% Gets the value Value of a global variable named Key (must be an atom)
bb_get(Key, Value) :-
( atom(Key) ->
'$fetch_global_var'(Key, Value)
@@ -52,12 +103,23 @@ bb_get(Key, Value) :-
:- meta_predicate(call_cleanup(0, 0)).
%% call_cleanup(Goal, Cleanup).
%
% Executes Goal and then, either on success or failure, executes Cleanup.
% The success or failure of Cleanup is ignored and choice points created inside are destroyed.
call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
:- non_counted_backtracking setup_call_cleanup/3.
%% setup_call_cleanup(Setup, Goal, Cleanup).
%
% If Setup succeeds, Cleanup will be called after the execution of Goal. Goal itself can succeed or not.
%
% In this example, we use the predicate to always close an open file:
%
% ?- setup_call_cleanup(open(File, read, Stream), do_something_with_stream(Stream), close(Stream)).
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
'$call_with_inference_counting'(call(S)),
@@ -144,6 +206,9 @@ handle_ile(B, _, _) :-
:- non_counted_backtracking call_with_inference_limit/3.
%% call_with_inference_limit(Goal, Limit, Result).
%
% Similar to `call(Goal)` but it limits the number of inferences for each solution of Goal.
call_with_inference_limit(G, L, R) :-
( integer(L) ->
( L < 0 ->
@@ -186,6 +251,10 @@ call_with_inference_limit(_, _, R, Bb, B) :-
),
handle_ile(B, Ball, R).
%% partial_string(String, L, L0)
%
% Explicitly construct a partial string "manually". It can be used as an optimized append/3.
% It's not recommended to use this predicate in application code.
partial_string(String, L, L0) :-
( String == [] ->
L = L0
@@ -195,9 +264,17 @@ partial_string(String, L, L0) :-
'$create_partial_string'(Atom, L, L0)
).
%% partial_string(+String)
%
% Succeeds if String is a _partial string_. A partial string is a string composed of several smaller
% strings, even just one. That means all strings in Scryer are partial strings.
partial_string(String) :-
'$is_partial_string'(String).
%% partial_string_tail(+String, -Tail).
%
% Unifies Tail with the last section of the partial string.
% It's not recommended to use this predicate in application code.
partial_string_tail(String, Tail) :-
( partial_string(String) ->
'$partial_string_tail'(String, Tail)
@@ -209,6 +286,9 @@ partial_string_tail(String, Tail) :-
:- meta_predicate(call_nth(0, ?)).
%% call_nth(Goal, N).
%
% Succeeds when Goal succeeded for the Nth time (there are at least N solutions)
call_nth(Goal, N) :-
can_be(integer, N),
( integer(N) ->
@@ -247,16 +327,24 @@ call_nth_nesting(C, ID) :-
bb_put(i_call_nth_counter, C).
%% copy_term_nat(Source, Dest)
%
% Similar to copy\_term/2 but without attribute variables
copy_term_nat(Source, Dest) :-
'$copy_term_without_attr_vars'(Source, Dest).
%% asserta(Module, Rule_Fact).
%
% Similar to asserta/1 but allows specifying a Module
asserta(Module, (Head :- Body)) :-
!,
'$asserta'(Module, Head, Body).
asserta(Module, Fact) :-
'$asserta'(Module, Fact, true).
%% assertz(Module, Rule_Fact).
%
% Similar to assertz/1 but allows specifying a Module
assertz(Module, (Head :- Body)) :-
!,
'$assertz'(Module, Head, Body).

203
src/lib/lists.pl
View File

@@ -1,3 +1,7 @@
/**
List manipulation predicates
*/
:- module(lists, [member/2, select/3, append/2, append/3, foldl/4, foldl/5,
memberchk/2, reverse/2, length/2, maplist/2,
maplist/3, maplist/4, maplist/5, maplist/6,
@@ -57,6 +61,18 @@
resource_error(Resource, Context) :-
throw(error(resource_error(Resource), Context)).
%% length(?Xs, ?N).
%
% Relates a list to its length (number of items). It can be used to count the elements of a current list or
% to create a list full of free variables with N length.
%
% ?- length([a,b,c], 3).
% true.
% ?- length([a,b,c], N).
% N = 3.
% ?- length(Xs, 3).
% Xs = [_A, _B, _C].
length(Xs0, N) :-
'$skip_max_list'(M, N, Xs0,Xs),
!,
@@ -95,28 +111,61 @@ length_addendum([_|Xs], N, M) :-
M1 is M + 1,
length_addendum(Xs, N, M1).
%% member(?X, ?Xs).
%
% Succeeds when X unifies with an item of the list Xs, which can be at any position.
%
% ?- member(X, "hello world").
% X = h
% ; ... .
%
member(X, [X|_]).
member(X, [_|Xs]) :- member(X, Xs).
%% select(X, Xs0, Xs1).
%
% Succeeds when the list Xs1 is the list Xs0 without the item X
%
% ?- select(c, "abcd", X).
% X = "abd".
%
select(X, [X|Xs], Xs).
select(X, [Y|Xs], [Y|Ys]) :- select(X, Xs, Ys).
%% append(+XsXs, ?Xs).
%
% Concatenates a list of lists
%
% ?- append([[1, 2], [3]], Xs).
% Xs = [1, 2, 3].
%
append([], []).
append([L0|Ls0], Ls) :-
append(L0, Rest, Ls),
append(Ls0, Rest).
%% append(Xs0, Xs1, Xs).
%
% List Xs is the concatenation of Xs0 and Xs1
%
% ?- append([1,2,3], [4,5,6], Xs).
% Xs = [1, 2, 3, 4, 5, 6].
%
append([], R, R).
append([X|L], R, [X|S]) :- append(L, R, S).
%% memberchk(?X, +Xs).
%
% This predicate is similar to member/2, but it only provides a single answer
memberchk(X, Xs) :- member(X, Xs), !.
%% reverse(?Xs, ?Ys).
%
% Xs is the Ys list in reverse order
%
% ?- reverse([1,2,3], [3,2,1]).
% true.
%
reverse(Xs, Ys) :-
( nonvar(Xs) -> reverse(Xs, Ys, [], Xs)
; reverse(Ys, Xs, [], Ys)
@@ -126,62 +175,111 @@ reverse([], [], YsRev, YsRev).
reverse([_|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
reverse(Xs, Ys, [Y1|YsPreludeRev], Xss).
%% maplist(+Predicate, ?Xs0).
%
% This is a metapredicate that applies predicate to each element of the list Xs0
%
% ?- maplist(write, [1,2,3]).
% 123 true.
%
maplist(_, []).
maplist(Cont1, [E1|E1s]) :-
call(Cont1, E1),
maplist(Cont1, E1s).
%% maplist(+Predicate, ?Xs0, ?Xs1).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0 and Xs1.
%
% ?- maplist(length, ["hello", "prolog", "marseille"], Xs1).
% Xs1 = [5,6,9].
%
maplist(_, [], []).
maplist(Cont2, [E1|E1s], [E2|E2s]) :-
call(Cont2, E1, E2),
maplist(Cont2, E1s, E2s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1 and Xs2.
maplist(_, [], [], []).
maplist(Cont3, [E1|E1s], [E2|E2s], [E3|E3s]) :-
call(Cont3, E1, E2, E3),
maplist(Cont3, E1s, E2s, E3s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2 and Xs3.
maplist(_, [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s]) :-
call(Cont, E1, E2, E3, E4),
maplist(Cont, E1s, E2s, E3s, E4s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3 and Xs4.
maplist(_, [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s]) :-
call(Cont, E1, E2, E3, E4, E5),
maplist(Cont, E1s, E2s, E3s, E4s, E5s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4 and Xs5.
maplist(_, [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s]) :-
call(Cont, E1, E2, E3, E4, E5, E6),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5, ?Xs6).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4, Xs5 and Xs6.
maplist(_, [], [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s]) :-
call(Cont, E1, E2, E3, E4, E5, E6, E7),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5, ?Xs6, ?Xs7).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4, Xs5, Xs6 and Xs7.
maplist(_, [], [], [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s], [E8|E8s]) :-
call(Cont, E1, E2, E3, E4, E5, E6, E7, E8),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s).
%% sum_list(+Xs, -Sum).
%
% Takes a lists of numbers and unifies Sum with the result of summing all the elements of the list.
%
% ?- sum_list([2,2,2], 6).
% true.
sum_list(Ls, S) :-
foldl(lists:sum_, Ls, 0, S).
sum_(L, S0, S) :- S is S0 + L.
%% same_length(?Xs, ?Ys).
%
% Succeeds if Xs and Ys are lists of the same length
same_length([], []).
same_length([_|As], [_|Bs]) :-
same_length(As, Bs).
%% foldl(+Predicate, ?Ls, +A0, ?A).
%
% foldl, sometimes called reduce, is a metapredicate that takes a predicate, a list of items
% and a starting value, and outputs a single value. The predicate _Predicate_ must be able to take the current
% element of the list, the previous value of the computation and the next value of the computation.
%
% For example, if we define sum_ as:
%
% sum_(L, S0, S) :- S is S0 + L.
%
% Then we can define sum\_list/2 as the following:
%
% sum_list(Ls, S) :- foldl(sum_, Ls, 0, S).
%
foldl(Goal_3, Ls, A0, A) :-
foldl_(Ls, Goal_3, A0, A).
@@ -191,7 +289,9 @@ foldl_([L|Ls], G_3, A0, A) :-
call(G_3, L, A0, A1),
foldl_(Ls, G_3, A1, A).
%% foldl(+Predicate, ?Ls0, ?Ls1, +A0, ?A).
%
% Same as foldl/4 but with an extra list
foldl(Goal_4, Xs, Ys, A0, A) :-
foldl_(Xs, Ys, Goal_4, A0, A).
@@ -201,6 +301,13 @@ foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
call(G_4, X, Y, A0, A1),
foldl_(Xs, Ys, G_4, A1, A).
%% transpose(?Ls, ?Ts).
%
% If Ls is a list of lists, Ts contains the transposition
%
% ?- transpose([[1,1],[2,2]], Ts).
% Ts = [[1,2],[1,2]].
%
transpose(Ls, Ts) :-
lists_transpose(Ls, Ts).
@@ -214,7 +321,13 @@ transpose_(_, Fs, Lists0, Lists) :-
list_first_rest([L|Ls], L, Ls).
%% list_to_set(+Ls0, -Set).
%
% Takes a list Ls0 and returns a list Set that doesn't contain any repeated element
%
% ?- list_to_set([2,3,4,4,1,2], Set).
% Set = [2,3,4,1].
%
list_to_set(Ls0, Ls) :-
maplist(lists:with_var, Ls0, LVs0),
keysort(LVs0, LVs),
@@ -242,7 +355,12 @@ unify_same(E-V, Prev-Var, E-V) :-
; true
).
%% nth0(?N, ?Ls, ?E).
%
% Succeeds if in the N position of the list Ls, we found the element E. The elements start counting from zero.
%
% ?- nth0(2, [1,2,3,4], 3).
% true.
nth0(N, Es0, E) :-
nonvar(N),
'$skip_max_list'(Skip, N, Es0,Es1),
@@ -277,6 +395,12 @@ nth0_el(N0,N, _,E, [E0|Es0]) :-
N1 is N0+1,
nth0_el(N1,N, E0,E, Es0).
%% nth1(?N, ?Ls, ?E).
%
% Succeeds if in the N position of the list Ls, we found the element E. The elements start counting from one.
%
% ?- nth1(2, [1,2,3,4], 2).
% true.
nth1(N, Es0, E) :-
N \== 0,
nth0(N, [_|Es0], E),
@@ -291,6 +415,12 @@ skipn(N0, Es0,Es, Xs0,Xs) :-
skipn(N1, Es1,Es, Xs1,Xs).
skipn(0, Es,Es, Xs,Xs).
%% nth0(?N, ?Ls, ?E, ?Rs).
%
% Succeeds if in the N position of the list Ls, we found the element E and the rest of the list is Rs. The elements start counting from zero.
%
% ?- nth0(2, [1,2,3,4], 3, [1,2,4]).
% true.
nth0(N, Es0, E, Es) :-
integer(N),
N >= 0,
@@ -315,45 +445,54 @@ nth0_elx(N0,N, E0,E, [E1|Es0], [E0|Es]) :-
% p.p.8.5
%% nth1(?N, ?Ls, ?E, ?Rs).
%
% Succeeds if in the N position of the list Ls, we found the element E and the rest of the list is Rs. The elements start counting from one.
%
% ?- nth1(2, [1,2,3,4], 2, [1,3,4]).
% true.
nth1(N, Es0, E, Es) :-
N \== 0,
nth0(N, [_|Es0], E, [_|Es]),
N \== 0.
%% list_max(+Xs, -Max).
%
% Takes a list Xs and unifies with the maximum value of the list
list_max([N|Ns], Max) :-
foldl(lists:list_max_, Ns, N, Max).
list_max_(N, Max0, Max) :-
Max is max(N, Max0).
%% list_min(+Xs, -Min).
%
% Takes a list Xs and unifies with the minimum value of the list
list_min([N|Ns], Min) :-
foldl(lists:list_min_, Ns, N, Min).
list_min_(N, Min0, Min) :-
Min is min(N, Min0).
%! permutation(?Xs, ?Ys) is nondet.
%% permutation(?Xs, ?Ys) is nondet.
%
% True when Xs is a permutation of Ys. This can solve for Ys given
% Xs or Xs given Ys, or even enumerate Xs and Ys together. The
% predicate permutation/2 is primarily intended to generate
% permutations. Note that a list of length N has N! permutations,
% and unbounded permutation generation becomes prohibitively
% expensive, even for rather short lists (10! = 3,628,800).
% True when Xs is a permutation of Ys. This can solve for Ys given
% Xs or Xs given Ys, or even enumerate Xs and Ys together. The
% predicate permutation/2 is primarily intended to generate
% permutations. Note that a list of length N has N! permutations,
% and unbounded permutation generation becomes prohibitively
% expensive, even for rather short lists (10! = 3,628,800).
%
% The example below illustrates that Xs and Ys being proper lists
% is not a sufficient condition to use the above replacement.
% The example below illustrates that Xs and Ys being proper lists
% is not a sufficient condition to use the above replacement.
%
% ==
% ?- permutation([1,2], [X,Y]).
% X = 1, Y = 2 ;
% X = 2, Y = 1 ;
% false.
% ==
% X = 1, Y = 2
% ; X = 2, Y = 1
% ; false.
%
% @error type_error(list, Arg) if either argument is not a proper
% or partial list.
% Throws type\_error(list, Arg) if either argument is not a proper
% or partial list.
permutation(Xs, Ys) :-
'$skip_max_list'(Xlen, _, Xs, XTail),

187
src/lib/ordsets.pl
View File

@@ -54,20 +54,19 @@
:- use_module(library(lists)).
/** <module> Ordered set manipulation
/** Ordered set manipulation
Ordered sets are lists with unique elements sorted to the standard order
of terms (see sort/2). Exploiting ordering, many of the set operations
can be expressed in order N rather than N^2 when dealing with unordered
sets that may contain duplicates. The library(ordsets) is available in a
number of Prolog implementations. Our predicates are designed to be
compatible with common practice in the Prolog community. The
implementation is incomplete and relies partly on library(oset), an
older ordered set library distributed with SWI-Prolog. New applications
are advised to use library(ordsets).
compatible with common practice in the Prolog community.
Some of these predicates match directly to corresponding list
operations. It is advised to use the versions from this library to make
clear you are operating on ordered sets. An exception is member/2. See
ord_memberchk/2.
ord\_memberchk/2.
The ordsets library is based on the standard order of terms. This
implies it can handle all Prolog terms, including variables. Note
however, that the ordering is not stable if a term inside the set is
@@ -80,13 +79,13 @@ fresh variable. In other cases one should cease using it as an ordset
because the order it relies on may have been changed.
*/
%! is_ordset(@Term) is semidet.
%% is_ordset(@Term) is semidet.
%
% True if Term is an ordered set. All predicates in this library
% expect ordered sets as input arguments. Failing to fullfil this
% assumption results in undefined behaviour. Typically, ordered
% sets are created by predicates from this library, sort/2 or
% setof/3.
% True if Term is an ordered set. All predicates in this library
% expect ordered sets as input arguments. Failing to fullfil this
% assumption results in undefined behaviour. Typically, ordered
% sets are created by predicates from this library, sort/2 or
% setof/3.
is_ordset(Term) :-
'$skip_max_list'(_, _, Term, Tail), Tail == [], %% is_list(Term),
@@ -102,37 +101,35 @@ is_ordset3([H2|T], H) :-
is_ordset3(T, H2).
%! ord_empty(?List) is semidet.
%% ord_empty(?List) is semidet.
%
% True when List is the empty ordered set. Simply unifies list
% with the empty list. Not part of Quintus.
% True when List is the empty ordered set. Simply unifies list
% with the empty list. Not part of Quintus.
ord_empty([]).
%! ord_seteq(+Set1, +Set2) is semidet.
%% ord_seteq(+Set1, +Set2) is semidet.
%
% True if Set1 and Set2 have the same elements. As both are
% canonical sorted lists, this is the same as ==/2.
%
% @compat sicstus
% True if Set1 and Set2 have the same elements. As both are
% canonical sorted lists, this is the same as ==/2.
ord_seteq(Set1, Set2) :-
Set1 == Set2.
%! list_to_ord_set(+List, -OrdSet) is det.
%% list_to_ord_set(+List, -OrdSet) is det.
%
% Transform a list into an ordered set. This is the same as
% sorting the list.
% Transform a list into an ordered set. This is the same as
% sorting the list.
list_to_ord_set(List, Set) :-
sort(List, Set).
%! ord_intersect(+Set1, +Set2) is semidet.
%% ord_intersect(+Set1, +Set2) is semidet.
%
% True if both ordered sets have a non-empty intersection.
% True if both ordered sets have a non-empty intersection.
ord_intersect([H1|T1], L2) :-
ord_intersect_(L2, H1, T1).
@@ -148,31 +145,29 @@ ord_intersect__(>, H1, T1, _H2, T2) :-
ord_intersect_(T2, H1, T1).
%! ord_disjoint(+Set1, +Set2) is semidet.
%% ord_disjoint(+Set1, +Set2) is semidet.
%
% True if Set1 and Set2 have no common elements. This is the
% negation of ord_intersect/2.
% True if Set1 and Set2 have no common elements. This is the
% negation of ord\_intersect/2.
ord_disjoint(Set1, Set2) :-
\+ ord_intersect(Set1, Set2).
%! ord_intersect(+Set1, +Set2, -Intersection)
%% ord_intersect(+Set1, +Set2, -Intersection)
%
% Intersection holds the common elements of Set1 and Set2.
% Intersection holds the common elements of Set1 and Set2.
%
% @deprecated Use ord_intersection/3
% This predicate is **deprecated**. Use ord\_intersection/3
ord_intersect(Set1, Set2, Intersection) :-
oset_int(Set1, Set2, Intersection).
%! ord_intersection(+PowerSet, -Intersection)
%% ord_intersection(+PowerSet, -Intersection)
%
% Intersection of a powerset. True when Intersection is an ordered
% set holding all elements common to all sets in PowerSet.
%
% @compat sicstus
% Intersection of a powerset. True when Intersection is an ordered
% set holding all elements common to all sets in PowerSet.
ord_intersection(PowerSet, Intersection) :-
key_by_length(PowerSet, Pairs),
@@ -190,10 +185,10 @@ l_int([_-H|T], S0, S) :-
l_int(T, S1, S).
%! ord_intersection(+Set1, +Set2, -Intersection) is det.
%% ord_intersection(+Set1, +Set2, -Intersection) is det.
%
% Intersection holds the common elements of Set1 and Set2. Uses
% ord_disjoint/2 if Intersection is bound to `[]` on entry.
% Intersection holds the common elements of Set1 and Set2. Uses
% ord\_disjoint/2 if Intersection is bound to `[]` on entry.
ord_intersection(Set1, Set2, Intersection) :-
( Intersection == []
@@ -202,13 +197,11 @@ ord_intersection(Set1, Set2, Intersection) :-
).
%! ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) is det.
%% ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) is det.
%
% Intersection and difference between two ordered sets.
% Intersection is the intersection between Set1 and Set2, while
% Difference is defined by ord_subtract(Set2, Set1, Difference).
%
% @see ord_intersection/3 and ord_subtract/3.
% Intersection and difference between two ordered sets.
% Intersection is the intersection between Set1 and Set2, while
% Difference is defined by ord\_subtract(Set2, Set1, Difference).
ord_intersection([], L, [], L) :- !.
ord_intersection([_|_], [], [], []) :- !.
@@ -224,35 +217,35 @@ ord_intersection2(>, H1, T1, H2, T2, Intersection, [H2|HDiff]) :-
ord_intersection([H1|T1], T2, Intersection, HDiff).
%! ord_add_element(+Set1, +Element, ?Set2) is det.
%% ord_add_element(+Set1, +Element, ?Set2) is det.
%
% Insert an element into the set. This is the same as
% ord_union(Set1, [Element], Set2).
% Insert an element into the set. This is the same as
% ord\_union(Set1, [Element], Set2).
ord_add_element(Set1, Element, Set2) :-
oset_addel(Set1, Element, Set2).
%! ord_del_element(+Set, +Element, -NewSet) is det.
%% ord_del_element(+Set, +Element, -NewSet) is det.
%
% Delete an element from an ordered set. This is the same as
% ord_subtract(Set, [Element], NewSet).
% Delete an element from an ordered set. This is the same as
% ord\_subtract(Set, [Element], NewSet).
ord_del_element(Set, Element, NewSet) :-
oset_delel(Set, Element, NewSet).
%! ord_selectchk(+Item, ?Set1, ?Set2) is semidet.
%% ord_selectchk(+Item, ?Set1, ?Set2) is semidet.
%
% Selectchk/3, specialised for ordered sets. Is true when
% select(Item, Set1, Set2) and Set1, Set2 are both sorted lists
% without duplicates. This implementation is only expected to work
% for Item ground and either Set1 or Set2 ground. The "chk" suffix
% is meant to remind you of memberchk/2, which also expects its
% first argument to be ground. ord_selectchk(X, S, T) =>
% ord_memberchk(X, S) & \+ ord_memberchk(X, T).
% Selectchk/3, specialised for ordered sets. Is true when
% select(Item, Set1, Set2) and Set1, Set2 are both sorted lists
% without duplicates. This implementation is only expected to work
% for Item ground and either Set1 or Set2 ground. The "chk" suffix
% is meant to remind you of memberchk/2, which also expects its
% first argument to be ground. ord\_selectchk(X, S, T) =>
% ord\_memberchk(X, S) & \\+ ord\_memberchk(X, T).
%
% @author Richard O'Keefe
% Author: Richard O'Keefe
ord_selectchk(Item, [X|Set1], [X|Set2]) :-
X @< Item,
@@ -266,19 +259,19 @@ ord_selectchk(Item, [Item|Set1], Set1) :-
).
%! ord_memberchk(+Element, +OrdSet) is semidet.
%% ord_memberchk(+Element, +OrdSet) is semidet.
%
% True if Element is a member of OrdSet, compared using ==. Note
% that _enumerating_ elements of an ordered set can be done using
% member/2.
% True if Element is a member of OrdSet, compared using ==. Note
% that _enumerating_ elements of an ordered set can be done using
% member/2.
%
% Some Prolog implementations also provide ord_member/2, with the
% same semantics as ord_memberchk/2. We believe that having a
% semidet ord_member/2 is unacceptably inconsistent with the *_chk
% convention. Portable code should use ord_memberchk/2 or
% member/2.
% Some Prolog implementations also provide ord\_member/2, with the
% same semantics as ord\_memberchk/2. We believe that having a
% semidet ord\_member/2 is unacceptably inconsistent with the \*\_chk
% convention. Portable code should use ord\_memberchk/2 or
% member/2.
%
% @author Richard O'Keefe
% Author: Richard O'Keefe
ord_memberchk(Item, [X1,X2,X3,X4|Xs]) :-
!,
@@ -303,9 +296,9 @@ ord_memberchk(Item, [X1]) :-
Item == X1.
%! ord_subset(+Sub, +Super) is semidet.
%% ord_subset(+Sub, +Super) is semidet.
%
% Is true if all elements of Sub are in Super
% Is true if all elements of Sub are in Super
ord_subset([], _).
ord_subset([H1|T1], [H2|T2]) :-
@@ -319,22 +312,20 @@ ord_subset_(=, _, T1, T2) :-
ord_subset(T1, T2).
%! ord_subtract(+InOSet, +NotInOSet, -Diff) is det.
%% ord_subtract(+InOSet, +NotInOSet, -Diff) is det.
%
% Diff is the set holding all elements of InOSet that are not in
% NotInOSet.
% Diff is the set holding all elements of InOSet that are not in
% NotInOSet.
ord_subtract(InOSet, NotInOSet, Diff) :-
oset_diff(InOSet, NotInOSet, Diff).
%! ord_union(+SetOfSets, -Union) is det.
%% ord_union(+SetOfSets, -Union) is det.
%
% True if Union is the union of all elements in the superset
% SetOfSets. Each member of SetOfSets must be an ordered set, the
% sets need not be ordered in any way.
%
% @author Copied from YAP, probably originally by Richard O'Keefe.
% True if Union is the union of all elements in the superset
% SetOfSets. Each member of SetOfSets must be an ordered set, the
% sets need not be ordered in any way.
ord_union([], []).
ord_union([Set|Sets], Union) :-
@@ -355,18 +346,18 @@ ord_union_all(N, Sets0, Union, Sets) :-
).
%! ord_union(+Set1, +Set2, ?Union) is det.
%% ord_union(+Set1, +Set2, ?Union) is det.
%
% Union is the union of Set1 and Set2
% Union is the union of Set1 and Set2
ord_union(Set1, Set2, Union) :-
oset_union(Set1, Set2, Union).
%! ord_union(+Set1, +Set2, -Union, -New) is det.
%% ord_union(+Set1, +Set2, -Union, -New) is det.
%
% True iff ord_union(Set1, Set2, Union) and
% ord_subtract(Set2, Set1, New).
% True iff ord\_union(Set1, Set2, Union) and
% ord\_subtract(Set2, Set1, New).
ord_union([], Set2, Set2, Set2).
ord_union([H|T], Set2, Union, New) :-
@@ -390,26 +381,22 @@ ord_union_2([H|T], H2, T2, Union, New) :-
ord_union(Order, H, T, H2, T2, Union, New).
%! ord_symdiff(+Set1, +Set2, ?Difference) is det.
%% ord_symdiff(+Set1, +Set2, ?Difference) is det.
%
% Is true when Difference is the symmetric difference of Set1 and
% Set2. I.e., Difference contains all elements that are not in the
% intersection of Set1 and Set2. The semantics is the same as the
% sequence below (but the actual implementation requires only a
% single scan).
% Is true when Difference is the symmetric difference of Set1 and
% Set2. I.e., Difference contains all elements that are not in the
% intersection of Set1 and Set2. The semantics is the same as the
% sequence below (but the actual implementation requires only a
% single scan).
%
% ==
% ord_union(Set1, Set2, Union),
% ord_intersection(Set1, Set2, Intersection),
% ord_subtract(Union, Intersection, Difference).
% ==
% ord_union(Set1, Set2, Union),
% ord_intersection(Set1, Set2, Intersection),
% ord_subtract(Union, Intersection, Difference).
%
% For example:
%
% ==
% ?- ord_symdiff([1,2], [2,3], X).
% X = [1,3].
% ==
ord_symdiff([], Set2, Set2).
ord_symdiff([H1|T1], Set2, Difference) :-
@@ -457,7 +444,7 @@ ord_symdiff(>, H1, T1, H2, Set2, [H2|Difference]) :-
*/
/** <module> Ordered set manipulation
/* Ordered set manipulation
This library defines set operations on sets represented as ordered
lists.

47
src/lib/sockets.pl
View File

@@ -1,4 +1,9 @@
/**
Predicates for handling network sockets, both as a server and as a client.
As a server, you should open a socket an call socket\_server\_accept/4 to get a stream for each connection.
As a client, you should just open a socket and you will receive a stream.
In both cases, with a stream, you can use the usual predicates to read and write to the stream.
*/
:- module(sockets, [socket_client_open/3,
socket_server_open/2,
socket_server_accept/4,
@@ -7,6 +12,18 @@
:- use_module(library(error)).
%% socket_client_open(+Addr, -Stream, +Options).
%
% Open a socket to a server, returning a stream. Addr must satisfy `Addr = Address:Port`.
%
% The following options are available:
%
% * alias(+Alias): Set an alias to the stream
% * eof_action(+Action): Defined what happens if the end of the stream is reached. Values: `error`, `eof_code` and `reset`.
% * reposition(+Boolean): Specifies whether repositioning is required for the stream. `false` is the default.
% * type(+Type): Type can be `text` or `binary`. Defines the type of the stream, if it's optimized for plain text
% or just binary
%
socket_client_open(Addr, Stream, Options) :-
( var(Addr) ->
throw(error(instantiation_error, socket_client_open/3))
@@ -27,7 +44,11 @@ socket_client_open(Addr, Stream, Options) :-
socket_client_open/3),
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type).
%% socket_server_open(+Addr, -ServerSocket).
%
% Open a server socket, returning a ServerSocket. Use that ServerSocket to accept incoming connections in
% socket\_server\_accept/4. Addr must satisfy `Addr = Address:Port`. Depending on the operating system
% configuration, some ports might be reserved for superusers.
socket_server_open(Addr, ServerSocket) :-
must_be(var, ServerSocket),
( ( integer(Addr) ; var(Addr) ) ->
@@ -39,7 +60,19 @@ socket_server_open(Addr, ServerSocket) :-
'$socket_server_open'(Address, Port, ServerSocket)
).
%% socket_server_accept(+ServerSocket, -Client, -Stream, +Options).
%
% Given a ServerSocket and a list of Options, accepts a incoming connection, returning data from the Client and
% a Stream to read or write data.
%
% The following options are available:
%
% * alias(+Alias): Set an alias to the stream
% * eof_action(+Action): Defined what happens if the end of the stream is reached. Values: `error`, `eof_code` and `reset`.
% * reposition(+Boolean): Specifies whether repositioning is required for the stream. `false` is the default.
% * type(+Type): Type can be `text` or `binary`. Defines the type of the stream, if it's optimized for plain text
% or just binary
%
socket_server_accept(ServerSocket, Client, Stream, Options) :-
must_be(var, Client),
must_be(var, Stream),
@@ -48,10 +81,14 @@ socket_server_accept(ServerSocket, Client, Stream, Options) :-
socket_server_accept/4),
'$socket_server_accept'(ServerSocket, Client, Stream, Alias, EOFAction, Reposition, Type).
%% socket_server_close(+ServerSocket).
%
% Stops listening on that ServerSocket. It's recommended to always close a ServerSocket once it's no longer needed
socket_server_close(ServerSocket) :-
'$socket_server_close'(ServerSocket).
%% current_hostname(-HostName).
%
% Returns the current hostname of the computer in which Scryer Prolog is executing right now
current_hostname(HostName) :-
'$current_hostname'(HostName).

2
src/machine/attributed_variables.pl
View File

@@ -1,11 +1,9 @@
:- module('$atts', []).
driver(Vars, Values) :-
iterate(Vars, Values, ListOfListsOfGoalLists),
!,
call_goals(ListOfListsOfGoalLists),
'$reset_attr_var_state',
'$return_from_verify_attr'.
iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]) :-

14
src/machine/attributed_variables.rs
View File

@@ -33,8 +33,8 @@ impl AttrVarInitializer {
}
#[inline]
pub(super) fn reset(&mut self) {
self.attr_var_queue.clear();
pub(super) fn reset(&mut self, len: usize) {
self.attr_var_queue.truncate(len);
self.bindings.clear();
}
}
@@ -147,6 +147,16 @@ impl MachineState {
let value = unmark_cell_bits!(value);
if h != iter.focus() {
let deref_value = heap_bound_store(iter.heap, heap_bound_deref(iter.heap, value));
if deref_value.is_compound(iter.heap) {
// a cyclic structure is bound to the attributed variable at h.
// it mustn't be included in seen_vars.
continue;
}
}
seen_vars.push(value);
seen_set.insert(h);

24
src/machine/dispatch.rs
View File

@@ -3533,6 +3533,14 @@ impl Machine {
self.rename_file();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallFileCopy(_) => {
self.file_copy();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteFileCopy(_) => {
self.file_copy();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallWorkingDirectory(_) => {
try_or_throw!(self.machine_st, self.working_directory());
step_or_fail!(self, self.machine_st.p += 1);
@@ -3683,14 +3691,6 @@ impl Machine {
try_or_throw!(self.machine_st, self.get_single_char());
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallResetAttrVarState(_) => {
self.reset_attr_var_state();
self.machine_st.p += 1;
}
&Instruction::ExecuteResetAttrVarState(_) => {
self.reset_attr_var_state();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallTruncateIfNoLiftedHeapGrowthDiff(_) => {
self.truncate_if_no_lifted_heap_growth_diff();
step_or_fail!(self, self.machine_st.p += 1);
@@ -4152,14 +4152,6 @@ impl Machine {
self.get_cut_point();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetStaggeredCutPoint(_) => {
self.get_staggered_cut_point();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteGetStaggeredCutPoint(_) => {
self.get_staggered_cut_point();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetDoubleQuotes(_) => {
self.get_double_quotes();
step_or_fail!(self, self.machine_st.p += 1);

2
src/machine/machine_state.rs
View File

@@ -849,6 +849,7 @@ impl MachineState {
or_frame.prelude.tr = self.tr;
or_frame.prelude.h = self.heap.len();
or_frame.prelude.b0 = self.b0;
or_frame.prelude.attr_var_queue_len = self.attr_var_init.attr_var_queue.len();
self.b = b;
@@ -876,6 +877,7 @@ impl MachineState {
or_frame.prelude.tr = self.tr;
or_frame.prelude.h = self.heap.len();
or_frame.prelude.b0 = self.b0;
or_frame.prelude.attr_var_queue_len = self.attr_var_init.attr_var_queue.len();
self.b = b;

10
src/machine/mod.rs
View File

@@ -570,10 +570,11 @@ impl Machine {
let old_tr = or_frame.prelude.tr;
let curr_tr = self.machine_st.tr;
let target_h = or_frame.prelude.h;
let attr_var_queue_len = or_frame.prelude.attr_var_queue_len;
self.machine_st.tr = or_frame.prelude.tr;
self.reset_attr_var_state(attr_var_queue_len);
self.reset_attr_var_state();
self.machine_st.hb = target_h;
self.unwind_trail(old_tr, curr_tr);
@@ -603,9 +604,10 @@ impl Machine {
let old_tr = or_frame.prelude.tr;
let curr_tr = self.machine_st.tr;
let target_h = or_frame.prelude.h;
let attr_var_queue_len = or_frame.prelude.attr_var_queue_len;
self.machine_st.tr = or_frame.prelude.tr;
self.reset_attr_var_state();
self.reset_attr_var_state(attr_var_queue_len);
self.machine_st.hb = target_h;
self.machine_st.p = self.machine_st.p + offset;
@@ -640,7 +642,7 @@ impl Machine {
self.machine_st.tr = or_frame.prelude.tr;
self.machine_st.b = or_frame.prelude.b;
self.reset_attr_var_state();
self.reset_attr_var_state(or_frame.prelude.attr_var_queue_len);
self.machine_st.hb = target_h;
self.machine_st.p = self.machine_st.p + offset;
@@ -676,7 +678,7 @@ impl Machine {
self.machine_st.tr = or_frame.prelude.tr;
self.machine_st.b = or_frame.prelude.b;
self.reset_attr_var_state();
self.reset_attr_var_state(or_frame.prelude.attr_var_queue_len);
self.machine_st.hb = target_h;
self.machine_st.p += 1;

1
src/machine/stack.rs
View File

@@ -123,6 +123,7 @@ pub(crate) struct OrFramePrelude {
pub(crate) tr: usize,
pub(crate) h: usize,
pub(crate) b0: usize,
pub(crate) attr_var_queue_len: usize,
}
#[derive(Debug)]

671
src/machine/system_calls.rs
View File

File diff suppressed because it is too large Load Diff