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

Merge pull request #1885 from mthom/setof_bagof_fixes

Browse Source 
Fix group_by_variants/4 and keysort in setof/3
This commit is contained in:
Mark Thom
2023-07-18 12:35:10 -06:00
committed by GitHub
parent 56f6772422 ff5e9a793b
commit 1ba040c24d
9 changed files with 213 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
src/lib/builtins.pl
View File

@@ -140,7 +140,9 @@ call(_, _, _, _, _, _, _, _, _).
% * `occurs_check`: Returns if the occurs check is enabled. The occurs check prevents the creation cyclic terms.
% Historically the Prolog unification algorithm didn't do that check so changing the value modifies how Prolog
% operates in the low-level. Possible values are `false` (default), `true` (unification has this check
% enabled) and `error` which throws an exception when a cylic term is created. Read ans write.
% enabled) and `error` which throws an exception when a cylic term is created. Read and write.
% * `unknown`: How undefined predicates are handled when called. Possible values are `error` (the default, an error is thrown),
% `fail` (the call silently fails) and `warn` (the call fails and a warning about the undefined predicate is printed).
%
current_prolog_flag(Flag, Value) :- Flag == max_arity, !, Value = 1023.
current_prolog_flag(max_arity, 1023).
@@ -150,6 +152,8 @@ current_prolog_flag(Flag, Value) :- Flag == integer_rounding_function, !, Value
current_prolog_flag(integer_rounding_function, toward_zero).
current_prolog_flag(Flag, Value) :- Flag == double_quotes, !, '$get_double_quotes'(Value).
current_prolog_flag(double_quotes, Value) :- '$get_double_quotes'(Value).
current_prolog_flag(Flag, Value) :- Flag == unknown, !, '$get_unknown'(Value).
current_prolog_flag(unknown, Value) :- '$get_unknown'(Value).
current_prolog_flag(Flag, _) :- Flag == max_integer, !, '$fail'.
current_prolog_flag(Flag, _) :- Flag == min_integer, !, '$fail'.
current_prolog_flag(Flag, OccursCheckEnabled) :-
@@ -190,6 +194,12 @@ set_prolog_flag(double_quotes, atom) :-
!, '$set_double_quotes'(atom). % 7.11.2.5, list of char codes (UTF8).
set_prolog_flag(double_quotes, codes) :-
!, '$set_double_quotes'(codes).
set_prolog_flag(unknown, error) :-
!, '$set_unknown'(error).
set_prolog_flag(unknown, warning) :-
!, '$set_unknown'(warning).
set_prolog_flag(unknown, fail) :-
!, '$set_unknown'(fail).
set_prolog_flag(occurs_check, true) :-
!, '$set_sto_as_unify'.
set_prolog_flag(occurs_check, false) :-
@@ -908,12 +918,45 @@ set_difference([X|Xs], [Y|Ys], Zs) :-
set_difference([], _, []) :- !.
set_difference(Xs, [], Xs).
% variant/2 checks whether X is a variant of Y per the definition in
% 7.1.6.1 of the ISO standard.
:- non_counted_backtracking variant/4.
variant(X,Y,VPs,VPs0) :-
( var(X) ->
var(Y),
VPs = [X-Y|VPs0]
; var(Y) ->
false
; X =.. [FX | XArgs],
Y =.. [FX | YArgs],
lists:foldl('$call'(builtins:variant), XArgs, YArgs, VPs, VPs0)
).
:- non_counted_backtracking variant/2.
singleton([_]).
variant(X, Y) :-
variant(X,Y, VPs, []),
keysort(VPs, SVPs),
pairs:group_pairs_by_key(SVPs, SVPKs),
pairs:pairs_values(SVPKs, Vals),
lists:maplist('$call'(builtins:term_variables), Vals, Vs),
lists:maplist('$call'(builtins:singleton), Vs),
term_variables(Vs, YVars),
lists:length(SVPKs, N),
lists:length(YVars, N).
:- non_counted_backtracking group_by_variant/4.
group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :-
V1 = V2, % \+ \+ (V1 = V2), % (2) % iso_ext:variant(V1, V2), % (1)
variant(V1, V2),
!,
% V1 = V2, % (3)
V1 = V2,
group_by_variant(Pairs, V2-S2, Solutions, Pairs0).
group_by_variant(Pairs, _, [], Pairs).
@@ -1033,7 +1076,7 @@ setof(Template, Goal, Solution) :-
term_variables(TemplateVars+GoalVars, TGVs),
lists:append(TemplateVars, Witnesses0, TGVs),
findall_with_existential(Template, Goal, PairedSolutions0, Witnesses0, Witnesses),
keysort(PairedSolutions0, PairedSolutions),
'$keysort_with_constant_var_ordering'(PairedSolutions0, PairedSolutions), % see 7.2.1
group_by_variants(PairedSolutions, GroupedSolutions),
iterate_variants_and_sort(GroupedSolutions, Witnesses, Solution).