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

Merge branch 'master' into ffi

Browse Source
This commit is contained in:
Adrián Arroyo Calle
2023-02-28 22:10:40 +01:00
committed by GitHub
parent 0ac93751d0 400ca21213
commit 7396630627
23 changed files with 1396 additions and 1485 deletions
Download Patch File Download Diff File Expand all files Collapse all files

92
src/lib/atts.pl
View File

@@ -19,74 +19,12 @@
'$default_attr_list'(PGs, Module, AttrVar).
'$default_attr_list'([], _, _) --> [].
'$absent_attr'(V, Attr) :-
'$get_attr_list'(V, Ls),
'$absent_from_list'(Ls, Attr).
'$absent_from_list'(X, Attr) :-
( var(X) ->
true
; X = [L|Ls],
L \= Attr ->
'$absent_from_list'(Ls, Attr)
).
'$get_attr'(V, Attr) :-
'$get_attr_list'(V, Ls),
nonvar(Ls),
'$get_from_list'(Ls, V, Attr).
'$get_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( L \= Attr ->
nonvar(Ls),
'$get_from_list'(Ls, V, Attr)
; L = Attr
).
'$put_attr'(V, Attr) :-
'$get_attr_list'(V, Ls),
'$add_to_list'(Ls, V, Attr).
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) ->
Ls = [Attr | _],
'$enqueue_attr_var'(V)
; Ls = [_ | Ls0],
'$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
var(Ls0),
!.
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr ->
'$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$del_attr_head'(V),
'$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, V, Attr) :-
( nonvar(Ls1) ->
Ls1 = [_ | Ls2],
'$del_attr_buried'(Ls1, Ls2, V, Attr)
'$absent_attr'(V, Module, Attr) :-
( '$get_from_attr_list'(V, Module, Attr) ->
false
; true
).
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
( var(Ls1) -> true
; Ls1 = [Att | Ls2] ->
( Att \= Attr ->
'$del_attr_buried'(Ls1, Ls2, V, Attr)
; '$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
'$del_attr_step'(Ls1, V, Attr)
)
).
'$copy_attr_list'(L, _Module, []) :- var(L), !.
'$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :-
( Module0 == Module ->
@@ -142,38 +80,28 @@ put_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },
[(put_atts(V, +Attr) :-
!,
functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
(put_atts(V, Attr) :-
'$put_to_attr_list'(V, Module, Attr)),
(put_atts(V, Attr) :-
!,
functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
'$put_to_attr_list'(V, Module, Attr)),
(put_atts(V, -Attr) :-
!,
functor(Attr, _, _),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
'$del_from_attr_list'(V, Module, Attr))].
get_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },
[(get_atts(V, +Attr) :-
!,
functor(Attr, _, _),
atts:'$get_attr'(V, Module:Attr)),
atts:'$get_from_attr_list'(V, Module, Attr)),
(get_atts(V, Attr) :-
!,
functor(Attr, _, _),
atts:'$get_attr'(V, Module:Attr)),
atts:'$get_from_attr_list'(V, Module, Attr)),
(get_atts(V, -Attr) :-
!,
functor(Attr, _, _),
atts:'$absent_attr'(V, Module:Attr))].
atts:'$absent_attr'(V, Module, Attr))].
user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
nonvar(Term),

4
src/lib/clpb.pl
View File

@@ -211,7 +211,7 @@ Here is an example session with a few queries and their answers:
T = 1, clpb:sat(X=:=X*Y), clpb:sat(Y=:=Y*Z).
?- sat(1#X#a#b).
sat(X=:=a#b).
clpb:sat(X=:=a#b).
```
The pending residual goals constrain remaining variables to Boolean
@@ -348,7 +348,7 @@ does compute =|XOR|= as intended:
```
?- xor(x, y, Z).
sat(Z=:=x#y).
clpb:sat(Z=:=x#y).
```
## Acknowledgments

24
src/lib/clpz.pl
View File

@@ -220,31 +220,23 @@ partition_([X|Xs], Pred, Ls0, Es0, Gs0) :-
:- meta_predicate(include(1, ?, ?)).
include(Goal, Ls0, Ls) :-
include_(Ls0, Goal, Ls).
include_([], _, []).
include_([L|Ls0], Goal, Ls) :-
include(_, [], []).
include(Goal, [L|Ls0], Ls) :-
( call(Goal, L) ->
Ls = [L|Rest]
; Ls = Rest
),
include_(Ls0, Goal, Rest).
include(Goal, Ls0, Rest).
:- meta_predicate(exclude(1, ?, ?)).
exclude(Goal, Ls0, Ls) :-
exclude_(Ls0, Goal, Ls).
exclude_([], _, []).
exclude_([L|Ls0], Goal, Ls) :-
exclude(_, [], []).
exclude(Goal, [L|Ls0], Ls) :-
( call(Goal, L) ->
Ls = Rest
; Ls = [L|Rest]
),
exclude_(Ls0, Goal, Rest).
exclude(Goal, Ls0, Rest).
%:- discontiguous clpz:goal_expansion/5.
@@ -7711,7 +7703,7 @@ attributes_goals([]) --> [].
attributes_goals([propagator(P, State)|As]) -->
( { ground(State) } -> []
; { phrase(attribute_goal_(P), Gs) } ->
{ % del_attr(State, clpz_aux), State = processed,
{ del_attr(State, clpz_aux), State = processed,
( monotonic ->
maplist(unwrap_with(bare_integer), Gs, Gs1)
; maplist(unwrap_with(=), Gs, Gs1)
@@ -7822,7 +7814,7 @@ conjunction(A, B, G, D) -->
original_goal(original_goal(State, Goal)) -->
( { var(State) } ->
% { State = processed },
{ State = processed },
[Goal]
; []
).

17
src/lib/dcgs.pl
View File

@@ -75,13 +75,6 @@ phrase(GRBody, S0, S) :-
; call(M:GRBody1, S0, S)
).
module_call_qualified(M, Call, Call1) :-
( nonvar(M) -> Call1 = M:Call
; Call = Call1
).
% The same version of the below two dcg_rule clauses, but with module scoping.
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
dcg_non_terminal(NonTerminal, S0, S, Head),
@@ -127,7 +120,10 @@ dcg_body(NonTerminal, S0, S, Goal1) :-
NonTerminal \= ( \+ _ ),
loader:strip_module(NonTerminal, M, NonTerminal0),
dcg_non_terminal(NonTerminal0, S0, S, Goal0),
module_call_qualified(M, Goal0, Goal1).
( functor(NonTerminal, (:), 2) ->
Goal1 = M:Goal0
; Goal1 = Goal0
).
% The following constructs in a grammar rule body
% are defined in the corresponding subclauses.
@@ -215,6 +211,9 @@ user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
E,
dcgs:error_goal(E, GRBody1)
),
module_call_qualified(M, GRBody1, GRBody2).
( GRBody = (_:_) ->
GRBody2 = M:GRBody1
; GRBody2 = GRBody1
).
user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).

17
src/lib/dif.pl
View File

@@ -40,9 +40,6 @@ verify_attributes(Var, Value, Goals) :-
; Goals = []
).
% Probably the world's worst dif/2 implementation. I'm open to
% suggestions for improvement.
%% dif(?X, ?Y).
%
% True iff X and Y are different terms. Unlike `\=/2`, `dif/2` is more declarative because if X and Y can
@@ -69,12 +66,16 @@ dif(X, Y) :-
)
).
gather_dif_goals([]) --> [].
gather_dif_goals([(X \== Y) | Goals]) -->
[dif:dif(X, Y)],
gather_dif_goals(Goals).
gather_dif_goals(_, []) --> [].
gather_dif_goals(V, [(X \== Y) | Goals]) -->
( { term_variables(X, [V0 | _]),
V == V0 } ->
[dif:dif(X, Y)]
; []
),
gather_dif_goals(V, Goals).
attribute_goals(X) -->
{ get_atts(X, +dif(Goals)) },
gather_dif_goals(Goals),
gather_dif_goals(X, Goals),
{ put_atts(X, -dif(_)) }.

12
src/lib/error.pl
View File

@@ -1,5 +1,5 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2018-2022 by Markus Triska (triska@metalevel.at)
Written 2018-2023 by Markus Triska (triska@metalevel.at)
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -85,11 +85,11 @@ must_be_(list, Term) :- check_(error:ilist, list, Term).
must_be_(type, Term) :- check_(error:type, type, Term).
must_be_(boolean, Term) :- check_(error:boolean, boolean, Term).
must_be_(term, Term) :-
( \+ ground(Term) ->
instantiation_error(must_be/2)
; \+ acyclic_term(Term) ->
type_error(term, Term, must_be/2)
; true
( acyclic_term(Term) ->
( ground(Term) -> true
; instantiation_error(must_be/2)
)
; type_error(term, Term, must_be/2)
).
% We cannot use maplist(must_be(character), Cs), because library(lists)

2
src/lib/freeze.pl
View File

@@ -38,5 +38,5 @@ freeze(X, Goal) :-
attribute_goals(Var) -->
{ get_atts(Var, frozen(Goals)),
put_atts(Var, -frozen(_)) },
[freeze(Var, Goals)].
[freeze:freeze(Var, Goals)].