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

Merge remote-tracking branch 'upstream/rebis-dev' into add-ugraphs-library

Browse Source
This commit is contained in:
Adrián Arroyo Calle
2022-01-07 19:14:34 +01:00
parent 0288d5dc19 693b6d2547
commit abf980d603
93 changed files with 37379 additions and 23840 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
src/lib/atts.pl
View File

@@ -24,30 +24,42 @@
'$absent_from_list'(Ls, Attr).
'$absent_from_list'(X, Attr) :-
( var(X) -> true
; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, 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_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, '$enqueue_attr_var'(V)
( L \= Attr ->
nonvar(Ls),
'$get_from_list'(Ls, V, Attr)
; L = Attr,
'$enqueue_attr_var'(V)
).
'$put_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, 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)
( var(Ls) ->
Ls = [Attr | _],
'$enqueue_attr_var'(V)
; Ls = [_ | Ls0],
'$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
var(Ls0), !.
var(Ls0),
!.
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
@@ -134,22 +146,22 @@ put_attr(Name, Arity, Module) -->
[(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)),
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) :-
!,
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)),
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) :-
!,
functor(Attr, _, _),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
get_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },

17
src/lib/between.pl
View File

@@ -12,17 +12,18 @@ between(Lower, Upper, X) :-
( nonvar(X) ->
Lower =< X,
X =< Upper
; compare(Ord, Lower, Upper),
between_(Ord, Lower, Upper, X)
; Lower =< Upper,
between_(Lower, Upper, X)
).
between_(<, Lower0, Upper, X) :-
( X = Lower0
; Lower1 is Lower0 + 1,
compare(Ord, Lower1, Upper),
between_(Ord, Lower1, Upper, X)
between_(Lower, Lower, Lower) :- !.
between_(Lower, Upper, Lower1) :-
( Lower < Upper,
( Lower1 = Lower
; Lower0 is Lower + 1,
between_(Lower0, Upper, Lower1)
)
).
between_(=, Upper, Upper, Upper).
enumerate_nats(I, I).
enumerate_nats(I0, N) :-

375
src/lib/builtins.pl
View File

@@ -1,4 +1,4 @@
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, (',')/2, (->)/2, (;)/2,
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, !/0, (',')/2, (->)/2, (;)/2,
(=..)/2, (:)/2, (:)/3, (:)/4, (:)/5, (:)/6,
(:)/7, (:)/8, (:)/9, (:)/10, (:)/11, (:)/12,
abolish/1, asserta/1, assertz/1,
@@ -59,65 +59,62 @@ call(G, A, B, C, D, E, F, G) :- '$call'(G, A, B, C, D, E, F, G).
call(G, A, B, C, D, E, F, G, H) :- '$call'(G, A, B, C, D, E, F, G, H).
Module : Predicate :-
( atom(Module) ->
'$module_call'(Module, Predicate)
;
throw(error(type_error(atom, Module), (:)/2))
).
% dynamic module resolution.
Module : Predicate :-
( atom(Module) -> '$module_call'(Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1) :-
( atom(Module) -> '$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) ->
'$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2) :-
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3) :-
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
% flags.
@@ -205,153 +202,119 @@ repeat.
repeat :- repeat.
:- meta_predicate ','(0,0).
:- meta_predicate ','(0, 0).
:- meta_predicate ;(0,0).
:- meta_predicate ','(0, +, +).
:- meta_predicate ->(0,0).
:- meta_predicate ;(0, 0).
! :- '$get_staggered_cp'(B), '$set_cp'(B).
:- meta_predicate ;(0, 0, +).
G1 -> G2 :- '$get_staggered_cp'(B), call('$call'(G1)), '$set_cp'(B), call('$call'(G2)).
:- meta_predicate ->(0, 0).
G ; _ :- call('$call'(G)).
_ ; G :- call('$call'(G)).
:- meta_predicate ->(0, 0, +).
','(G1, G2) :- '$get_staggered_cp'(B), comma_dispatch(G1,G2,B).
set_cp(B) :- '$set_cp'(B).
','(G1, G2) :-
'$get_b_value'(B),
( '$call_with_default_policy'(var(G1)) ->
throw(error(instantiation_error, (',')/2))
; '$call_with_default_policy'(','(G1, G2, B))
).
:- non_counted_backtracking comma_dispatch/3.
comma_dispatch(G1, G2, B) :-
comma_dispatch_prep((G1, G2), B, Conts),
comma_dispatch_call_list(Conts).
';'(G1, G2) :-
'$get_b_value'(B),
( '$call_with_default_policy'(var(G1)) ->
throw(error(instantiation_error, (';')/2))
; '$call_with_default_policy'(';'(G1, G2, B))
).
:- non_counted_backtracking comma_dispatch_prep/3.
G1 -> G2 :-
'$get_b_value'(B),
( '$call_with_default_policy'(var(G1)) ->
throw(error(instantiation_error, (->)/2))
; '$call_with_default_policy'(->(G1, G2, B))
).
:-non_counted_backtracking call_or_cut/3.
call_or_cut(G, B, ErrorPI) :-
( '$call_with_default_policy'(var(G)) ->
throw(error(instantiation_error, ErrorPI))
; '$call_with_default_policy'(call_or_cut(G, B))
).
:- non_counted_backtracking control_functor/1.
control_functor(_:G) :- nonvar(G), control_functor(G).
control_functor(call(_:C)) :- C == !.
control_functor(!).
control_functor((_,_)).
control_functor((_;_)).
control_functor((_->_)).
:- non_counted_backtracking call_or_cut/2.
call_or_cut(G, B) :-
( nonvar(G),
'$call_with_default_policy'(control_functor(G)) ->
'$call_with_default_policy'(call_or_cut_interp(G, B))
; call(G)
).
:- non_counted_backtracking call_or_cut_interp/2.
call_or_cut_interp(_ : G, B) :-
call_or_cut_interp(G, B).
call_or_cut_interp(call(_ : !), B) :-
!. % '$set_cp'(B).
call_or_cut_interp(!, B) :-
'$set_cp'(B).
call_or_cut_interp((G1, G2), B) :-
'$call_with_default_policy'(','(G1, G2, B)).
call_or_cut_interp((G1 ; G2), B) :-
'$call_with_default_policy'(';'(G1, G2, B)).
call_or_cut_interp((G1 -> G2), B) :-
'$call_with_default_policy'(->(G1, G2, B)).
:- non_counted_backtracking (',')/3.
','(G1, G2, B) :-
( nonvar(G1),
'$call_with_default_policy'(control_functor(G1)) ->
'$call_with_default_policy'(call_or_cut_interp(G1, B)),
'$call_with_default_policy'(call_or_cut(G2, B, (',')/2))
; call(G1),
'$call_with_default_policy'(call_or_cut(G2, B, (',')/2))
).
:- non_counted_backtracking (;)/3.
';'(G1, G2, B) :-
( nonvar(G1),
'$call_with_default_policy'(control_functor(G1)) ->
'$call_with_default_policy'(';-interp'(G1, G2, B))
; call(G1)
; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2))
).
:- non_counted_backtracking ';-interp'/3.
';-interp'((G1 -> G2), G3, B) :-
!,
( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) ->
'$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2))
).
';-interp'(_:(G1 -> G2), G3, B) :-
!,
( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) ->
'$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2))
).
';-interp'(G1, G2, B) :-
( '$call_with_default_policy'(call_or_cut_interp(G1, B))
; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2))
).
:- non_counted_backtracking (->)/3.
->(G1, G2, B) :-
( nonvar(G1),
'$call_with_default_policy'(control_functor(G1)) ->
( '$call_with_default_policy'(call_or_cut_interp(G1, B)) ->
'$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
comma_dispatch_prep(Gs, B, [Cont|Conts]) :-
( callable(Gs) ->
( functor(Gs, ',', 2) ->
arg(1, Gs, G1),
arg(2, Gs, G2),
( nonvar(G1), ( G1 = ! ; G1 = _:! ) ->
Cont = builtins:set_cp(B)
; Cont = G1
),
comma_dispatch_prep(G2, B, Conts)
; ( Gs = ! ; Gs = _:! ) ->
Cont = builtins:set_cp(B),
Conts = []
; Cont = Gs,
Conts = []
)
; call(G1) ->
'$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
; Cont = Gs,
Conts = []
).
:- non_counted_backtracking comma_dispatch_call_list/1.
comma_dispatch_call_list([]).
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
!,
'$call'(G1),
'$call'(G2),
'$call'(G3),
'$call'(G4),
'$call'(G5),
'$call'(G6),
'$call'(G7),
'$call'(G8),
'$call_with_default_policy'(comma_dispatch_call_list(Gs)).
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
!,
'$call'(G1),
'$call'(G2),
'$call'(G3),
'$call'(G4),
'$call'(G5),
'$call'(G6),
'$call'(G7).
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6]) :-
!,
'$call'(G1),
'$call'(G2),
'$call'(G3),
'$call'(G4),
'$call'(G5),
'$call'(G6).
comma_dispatch_call_list([G1,G2,G3,G4,G5]) :-
!,
'$call'(G1),
'$call'(G2),
'$call'(G3),
'$call'(G4),
'$call'(G5).
comma_dispatch_call_list([G1,G2,G3,G4]) :-
!,
'$call'(G1),
'$call'(G2),
'$call'(G3),
'$call'(G4).
comma_dispatch_call_list([G1,G2,G3]) :-
!,
'$call'(G1),
'$call'(G2),
'$call'(G3).
comma_dispatch_call_list([G1,G2]) :-
!,
'$call'(G1),
'$call'(G2).
comma_dispatch_call_list([G1]) :-
'$call'(G1).
% univ.
:- non_counted_backtracking univ_errors/3.
univ_errors(Term, List, N) :-
'$skip_max_list'(N, -1, List, R),
( var(R) ->
( var(Term),
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
; true
)
( var(R) ->
( var(Term),
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
; true
)
; R \== [] ->
throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b)
; List = [H|T] ->
@@ -388,9 +351,10 @@ univ_worker(Term, List, _) :-
!,
'$call_with_default_policy'(List = [Term]).
univ_worker(Term, [Name|Args], N) :-
var(Term), !,
var(Term),
!,
'$call_with_default_policy'(Arity is N-1),
'$call_with_default_policy'(functor(Term, Name, Arity)),
'$call_with_default_policy'(functor(Term, Name, Arity)), % Term = {var}, Name = nonvar, Arity = 0.
'$call_with_default_policy'(get_args(Args, Term, 1, Arity)).
univ_worker(Term, List, _) :-
'$call_with_default_policy'(functor(Term, Name, Arity)),
@@ -620,9 +584,11 @@ throw(Ball) :-
),
'$unwind_stack'.
:- non_counted_backtracking '$iterate_find_all'/4.
'$iterate_find_all'(Template, Goal, _, LhOffset) :-
call(Goal),
'$call'(Goal),
'$copy_to_lh'(LhOffset, Template),
'$fail'.
'$iterate_find_all'(_, _, Solutions, LhOffset) :-
@@ -636,7 +602,7 @@ truncate_lh_to(LhLength) :- '$truncate_lh_to'(LhLength).
:- meta_predicate findall(?, 0, ?).
findall(Template, Goal, Solutions) :-
error:can_be(list, Solutions),
'$call_with_default_policy'(error:can_be(list, Solutions)),
'$lh_length'(LhLength),
'$call_with_default_policy'(
catch(builtins:'$iterate_find_all'(Template, Goal, Solutions, LhLength),
@@ -644,7 +610,6 @@ findall(Template, Goal, Solutions) :-
( builtins:truncate_lh_to(LhLength), builtins:throw(Error) ))
).
:- non_counted_backtracking '$iterate_find_all_diff'/5.
'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :-
@@ -659,8 +624,8 @@ findall(Template, Goal, Solutions) :-
:- meta_predicate findall(?, 0, ?, ?).
findall(Template, Goal, Solutions0, Solutions1) :-
error:can_be(list, Solutions0),
error:can_be(list, Solutions1),
'$call_with_default_policy'(error:can_be(list, Solutions0)),
'$call_with_default_policy'(error:can_be(list, Solutions1)),
'$lh_length'(LhLength),
'$call_with_default_policy'(
catch(builtins:'$iterate_find_all_diff'(Template, Goal, Solutions0,
@@ -679,9 +644,9 @@ set_difference([], _, []) :- !.
set_difference(Xs, [], Xs).
group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :-
iso_ext:variant(V1, V2),
V1 = V2, % \+ \+ (V1 = V2), % (2) % iso_ext:variant(V1, V2), % (1)
!,
V1 = V2,
% V1 = V2, % (3)
group_by_variant(Pairs, V2-S2, Solutions, Pairs0).
group_by_variant(Pairs, _, [], Pairs).
@@ -779,11 +744,11 @@ setof(Template, Goal, Solution) :-
( var(H) ->
throw(error(instantiation_error, clause/2))
; callable(H), functor(H, Name, Arity) ->
( '$head_is_dynamic'(Module, H) ->
( '$no_such_predicate'(Module, H) ->
'$fail'
; '$head_is_dynamic'(Module, H) ->
'$clause_body_is_valid'(B),
Module:'$clause'(H, B)
; '$no_such_predicate'(Module, H) ->
'$fail'
; throw(error(permission_error(access, private_procedure, Name/Arity),
clause/2))
)
@@ -800,12 +765,11 @@ clause(H, B) :-
arg(1, H, Module),
arg(2, H, F),
'$module_clause'(F, B, Module)
; '$no_such_predicate'(user, H) ->
'$fail'
; '$head_is_dynamic'(user, H) ->
'$clause_body_is_valid'(B),
'$clause'(H, B)
; '$no_such_predicate'(user, H) -> %% '$no_such_predicate' fails if
%% H is not callable.
'$fail'
; throw(error(permission_error(access, private_procedure, Name/Arity),
clause/2))
)
@@ -854,13 +818,14 @@ asserta_clause(Head, Body) :-
:- meta_predicate asserta(0).
asserta(Clause) :-
asserta(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
asserta_clause(Head, Body)
module_asserta_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
asserta_clause(Head, Body)
module_asserta_clause(Head, Body, Module)
).
module_assertz_clause(Head, Body, Module) :-
@@ -909,13 +874,14 @@ assertz_clause(Head, Body) :-
:- meta_predicate assertz(0).
assertz(Clause) :-
assertz(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
assertz_clause(Head, Body)
module_assertz_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
assertz_clause(Head, Body)
module_assertz_clause(Head, Body, Module)
).
@@ -999,13 +965,14 @@ retract_clause(Head, Body) :-
:- meta_predicate retract(0).
retract(Clause0) :-
strip_module(Clause0, Module, Clause),
( Clause = (Head :- Body) ->
true
; Head = Clause,
Body = true
),
retract_clause(Module:Head, Body).
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
retract_module_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
retract_module_clause(Head, Body, Module)
).
:- meta_predicate retractall(0).
@@ -1022,8 +989,10 @@ module_abolish(Pred, Module) :-
; Pred = Name/Arity ->
( var(Name) ->
throw(error(instantiation_error, abolish/1))
; var(Arity) ->
throw(error(instantiation_error, abolish/1))
; integer(Arity) ->
( \+ atom(Name) ->
(\+ atom(Name) ->
throw(error(type_error(atom, Name), abolish/1))
; Arity < 0 ->
throw(error(domain_error(not_less_than_zero, Arity), abolish/1))
@@ -1075,17 +1044,16 @@ abolish(Pred) :-
; throw(error(type_error(predicate_indicator, Pred), abolish/1))
).
'$iterate_db_refs'(Ref, Name/Arity) :-
'$lookup_db_ref'(Ref, Name, Arity).
'$iterate_db_refs'(Ref, Name/Arity) :-
'$get_next_db_ref'(Ref, NextRef),
'$iterate_db_refs'(NextRef, Name/Arity).
'$iterate_db_refs'(Name, Arity, Name/Arity). % :-
% '$lookup_db_ref'(Ref, Name, Arity).
'$iterate_db_refs'(RName, RArity, Name/Arity) :-
'$get_next_db_ref'(RName, RArity, RRName, RRArity),
'$iterate_db_refs'(RRName, RRArity, Name/Arity).
current_predicate(Pred) :-
( var(Pred) ->
'$get_next_db_ref'(Ref, _),
'$iterate_db_refs'(Ref, Pred)
'$get_next_db_ref'(RN, RA, _, _),
'$iterate_db_refs'(RN, RA, Pred)
; Pred \= _/_ ->
throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
; Pred = Name/Arity,
@@ -1094,15 +1062,14 @@ current_predicate(Pred) :-
; integer(Arity), Arity < 0
) ->
throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
; '$get_next_db_ref'(Ref, _),
'$iterate_db_refs'(Ref, Pred)
; '$get_next_db_ref'(RN, RA, _, _),
'$iterate_db_refs'(RN, RA, Pred)
).
'$iterate_op_db_refs'(Ref, Priority, Spec, Op) :-
'$lookup_op_db_ref'(Ref, Priority, Spec, Op).
'$iterate_op_db_refs'(Ref, Priority, Spec, Op) :-
'$get_next_op_db_ref'(Ref, NextRef),
'$iterate_op_db_refs'(NextRef, Priority, Spec, Op).
'$iterate_op_db_refs'(RPriority, RSpec, ROp, _, RPriority, RSpec, ROp).
'$iterate_op_db_refs'(RPriority, RSpec, ROp, OssifiedOpDir, Priority, Spec, Op) :-
'$get_next_op_db_ref'(RPriority, RSpec, ROp, OssifiedOpDir, RRPriority, RRSpec, RROp),
'$iterate_op_db_refs'(RRPriority, RRSpec, RROp, OssifiedOpDir, Priority, Spec, Op).
can_be_op_priority(Priority) :- var(Priority).
can_be_op_priority(Priority) :- op_priority(Priority).
@@ -1114,8 +1081,8 @@ current_op(Priority, Spec, Op) :-
( can_be_op_priority(Priority),
can_be_op_specifier(Spec),
error:can_be(atom, Op) ->
'$get_next_op_db_ref'(Ref, _),
'$iterate_op_db_refs'(Ref, Priority, Spec, Op)
'$get_next_op_db_ref'(RPriority, RSpec, ROp, OssifiedOpDir, _, _, Op),
'$iterate_op_db_refs'(RPriority, RSpec, ROp, OssifiedOpDir, Priority, Spec, Op)
).
list_of_op_atoms(Var) :-

150
src/lib/dcgs.pl
View File

@@ -1,16 +1,25 @@
:- module(dcgs,
[op(1105, xfy, '|'),
phrase/2,
phrase/3,
seq//1,
seqq//1,
... //0
]).
phrase/2,
phrase/3,
seq//1,
seqq//1,
... //0
]).
:- use_module(library(error)).
:- use_module(library(lists), [append/3]).
:- use_module(library(lists), [append/3, member/2]).
:- use_module(library(loader), [strip_module/3]).
load_context(GRBody, Module, GRBody0) :-
strip_module(GRBody, Module, GRBody0),
( nonvar(Module) ->
true
; prolog_load_context(module, Module) ->
true
; true
).
:- meta_predicate phrase(2, ?).
:- meta_predicate phrase(2, ?, ?).
@@ -18,77 +27,78 @@
phrase(GRBody, S0) :-
phrase(GRBody, S0, []).
phrase(GRBody, S0, S) :-
( var(GRBody) ->
throw(error(instantiation_error, phrase/3))
; strip_module(GRBody, Module, GRBody0),
; load_context(GRBody, Module, GRBody0),
dcg_constr(GRBody0) ->
( var(Module) ->
phrase_(GRBody0, S0, S)
; phrase_(Module:GRBody0, S0, S)
; phrase_(GRBody0, S0, S, Module)
)
; functor(GRBody, _, _) ->
call(GRBody, S0, S)
; throw(error(type_error(callable, GRBody), phrase/3))
).
phrase_([], S, S).
phrase_(!, S, S).
phrase_(_:[], S, S) :- !.
phrase_(_:!, S, S) :- !.
phrase_((A, B), S0, S) :-
phrase(A, S0, S1), phrase(B, S1, S).
phrase_(M:(A, B), S0, S) :-
!,
phrase(M:A, S0, S1), phrase(M:B, S1, S).
phrase_((A -> B ; C), S0, S) :-
!,
( phrase(A, S0, S1) ->
phrase(B, S1, S)
; phrase(C, S0, S)
).
phrase_(M:(A -> B ; C), S0, S) :-
!,
phrase_([], S, S, _).
phrase_(!, S, S, _).
phrase_((A, B), S0, S, M) :-
phrase(M:A, S0, S1),
phrase(M:B, S1, S).
phrase_((A -> B ; C), S0, S, M) :-
( phrase(M:A, S0, S1) ->
phrase(M:B, S1, S)
; phrase(M:C, S0, S)
).
phrase_((A ; B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_(M:(A ; B), S0, S) :-
!,
( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ).
phrase_((A | B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_(M:(A | B), S0, S) :-
!,
( phrase(M:A, S0, S) ; phrase(M:B, S0, S) ).
phrase_({G}, S0, S) :-
( call(G), S0 = S ).
phrase_(M:{G}, S0, S) :-
!,
( call(M:G), S0 = S ).
phrase_(call(G), S0, S) :-
call(G, S0, S).
phrase_(M:call(G), S0, S) :-
!,
phrase_((A ; B), S0, S, M) :-
( phrase(M:A, S0, S)
; phrase(M:B, S0, S)
).
phrase_((A | B), S0, S, M) :-
( phrase(M:A, S0, S)
; phrase(M:B, S0, S)
).
phrase_({G}, S, S, M) :-
call(M:G).
phrase_(call(G), S0, S, M) :-
call(M:G, S0, S).
phrase_((A -> B), S0, S) :-
phrase((A -> B ; fail), S0, S).
phrase_(M:(A -> B), S0, S) :-
!,
phrase((M:A -> M:B ; fail), S0, S).
phrase_(phrase(NonTerminal), S0, S) :-
phrase(NonTerminal, S0, S).
phrase_(M:phrase(NonTerminal), S0, S) :-
!,
phrase(M:NonTerminal, S0, S).
phrase_([T|Ts], S0, S) :-
append([T|Ts], S, S0).
phrase_(_:[T|Ts], S0, S) :-
phrase_((A -> B), S0, S, M) :-
( phrase(M:A, S0, S1) ->
phrase(M:B, S1, S)
; fail
).
phrase_(phrase(NonTerminal), S0, S, M) :-
phrase(NonTerminal, S0, S, M).
phrase_([T|Ts], S0, S, _) :-
append([T|Ts], S, S0).
phrase_([], S, S).
phrase_(!, S, S).
phrase_(M:G, S0, S) :-
phrase_(G, S0, S, M).
phrase_((A, B), S0, S) :-
phrase(A, S0, S1),
phrase(B, S1, S).
phrase_((A -> B ; C), S0, S) :-
( phrase(A, S0, S1) ->
phrase(B, S1, S)
; phrase(C, S0, S)
).
phrase_((A ; B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_((A | B), S0, S) :-
( phrase(A, S0, S) ; phrase(B, S0, S) ).
phrase_({G}, S0, S) :-
( call(G), S0 = S ).
phrase_(call(G), S0, S) :-
call(G, S0, S).
phrase_((A -> B), S0, S) :-
phrase((A -> B ; fail), S0, S).
phrase_(phrase(NonTerminal), S0, S) :-
phrase(NonTerminal, S0, S).
phrase_([T|Ts], S0, S) :-
append([T|Ts], S, S0).
% The same version of the below two dcg_rule clauses, but with module scoping.
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
@@ -193,3 +203,25 @@ seqq([Es|Ess]) --> seq(Es), seqq(Ess).
% Describes an arbitrary number of elements
... --> [] | [_], ... .
user:goal_expansion(phrase(GRBody, S, S0), phrase(GRBody1, S, S0)) :-
strip_module(GRBody, M, GRBody0),
var(M),
prolog_load_context(module, M),
( nonvar(GRBody0) ->
GRBody0 \== [],
dcg_constr(GRBody0),
predicate_property(GRBody0, meta_predicate(_))
),
GRBody1 = M:GRBody0.
user:goal_expansion(phrase(GRBody, S), phrase(GRBody1, S, [])) :-
strip_module(GRBody, M, GRBody0),
var(M),
prolog_load_context(module, M),
( nonvar(GRBody0) ->
GRBody0 \== [],
dcg_constr(GRBody0),
predicate_property(GRBody0, meta_predicate(_))
),
GRBody1 = M:GRBody0.

35
src/lib/iso_ext.pl
View File

@@ -14,7 +14,7 @@
partial_string_tail/2,
setup_call_cleanup/3,
call_nth/2,
variant/2,
% variant/2,
copy_term_nat/2]).
:- use_module(library(error), [can_be/2,
@@ -22,10 +22,7 @@
instantiation_error/1,
type_error/3]).
:- meta_predicate(call_cleanup(0, 0)).
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
:- use_module(library(lists), [maplist/3]).
:- meta_predicate(forall(0, 0)).
@@ -55,14 +52,17 @@ bb_get(Key, Value) :-
).
% setup_call_cleanup.
:- meta_predicate(call_cleanup(0, 0)).
call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
% setup_call_cleanup.
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
call(S),
'$call'(S),
'$set_cp_by_default'(B),
'$get_current_block'(Bb),
( C = _:CC,
@@ -71,6 +71,8 @@ setup_call_cleanup(S, G, C) :-
; '$call_with_default_policy'(scc_helper(C, G, Bb))
).
:- meta_predicate(scc_helper(?,0,?)).
:- non_counted_backtracking scc_helper/3.
scc_helper(C, G, Bb) :-
'$get_cp'(Cp),
@@ -96,7 +98,8 @@ scc_helper(_, _, _) :-
:- non_counted_backtracking run_cleaners_with_handling/0.
run_cleaners_with_handling :-
'$get_scc_cleaner'(C), '$get_level'(B),
'$get_scc_cleaner'(C),
'$get_level'(B),
'$call_with_default_policy'(catch(C, _, true)),
'$set_cp_by_default'(B),
'$call_with_default_policy'(run_cleaners_with_handling).
@@ -139,11 +142,17 @@ call_with_inference_limit(G, L, R) :-
'$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
'$remove_call_policy_check'(B).
install_inference_counter(B, L, Count0) :-
'$install_inference_counter'(B, L, Count0).
:- meta_predicate(call_with_inference_limit(0,?,?,?,?)).
:- non_counted_backtracking call_with_inference_limit/5.
call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0),
call(G),
'$call'(G),
'$inference_level'(R, B),
'$remove_inference_counter'(B, Count1),
'$call_with_default_policy'(is(Diff, L - (Count1 - Count0))),
@@ -160,14 +169,12 @@ call_with_inference_limit(_, _, R, Bb, B) :-
'$erase_ball',
'$call_with_default_policy'(handle_ile(B, Ball, R)).
variant(X, Y) :- '$variant'(X, Y).
partial_string(String, L, L0) :-
( String == [] ->
L = L0
; catch(atom_chars(Atom, String),
error(E, _),
throw(error(E, partial_string/3))),
error(E, _),
throw(error(E, partial_string/3))),
'$create_partial_string'(Atom, L, L0)
).

11
src/lib/lists.pl
View File

@@ -3,7 +3,7 @@
maplist/3, maplist/4, maplist/5, maplist/6,
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
sum_list/2, transpose/2, list_to_set/2, list_max/2,
list_min/2, permutation/2]).
list_min/2, permutation/2]).
/* Author: Mark Thom, Jan Wielemaker, and Richard O'Keefe
Copyright (c) 2018-2021, Mark Thom
@@ -56,13 +56,16 @@ length(Xs, N) :-
!,
'$skip_max_list'(M, -1, Xs, Xs0),
( Xs0 == [] -> N = M
; var(Xs0) -> length_addendum(Xs0, N, M)).
; var(Xs0) -> length_addendum(Xs0, N, M)
).
length(Xs, N) :-
integer(N),
N >= 0, !,
N >= 0,
!,
'$skip_max_list'(M, N, Xs, Xs0),
( Xs0 == [] -> N = M
; var(Xs0) -> R is N-M, length_rundown(Xs0, R)).
; var(Xs0) -> R is N-M, length_rundown(Xs0, R)
).
length(_, N) :-
integer(N), !,
domain_error(not_less_than_zero, N, length/2).

14
src/lib/serialization/abnf.pl
View File

@@ -9,26 +9,26 @@
syntaxes. The DCGs are presented in the order they appear in the RFC.
While some DCGs below use `char_type/2`, the most common ones are defined
manually in order to take advantage of Prolog's first-argument indexing.
BSD 3-Clause License
Copyright (c) 2021, Aram Panasenco
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
* Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

18
src/lib/serialization/json.pl
View File

@@ -1,29 +1,29 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu)
Part of Scryer Prolog.
`json_chars//1` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
or [`phrase/2`](src/lib/dcgs.pl) to parse and generate [JSON](https://www.json.org/json-en.html).
BSD 3-Clause License
Copyright (c) 2021, Aram Panasenco
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
* Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
@@ -44,7 +44,7 @@
:- use_module(library(dif)).
:- use_module(library(lists)).
/* The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html
/* The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html
as closely as possible. Note that the names in the McKeeman form conflict with the pictures on the site. */
json_chars(Internal) --> json_element(Internal).

2
src/lib/tabling/trie.pl
View File

@@ -41,6 +41,8 @@
trie_get_all_values/2 % +Trie, -Value
]).
:- use_module(library(format)).
:- use_module(library(assoc)).
:- use_module(library(atts)).
:- use_module(library(lists)).

6
src/lib/uuid.pl
View File

@@ -4,9 +4,9 @@
This library provides reasoning about UUID (only version 4 right now).
There are three predicates:
* uuidv4/1, to generate a new UUIDv4
* uuidv4_string/1, to generate a new UUIDv4 in string hex representation
* uuidv4_string/1, to generate a new UUIDv4 in string hex representation
* uuid_string/2, to converte between UUID list of bytes and UUID hex representation
Examples:
?- uuidv4(X).
X = [42,147,248,242,117,196,79,2,129,159|...].
@@ -30,7 +30,7 @@
:- use_module(library(dcgs)).
:- use_module(library(lists)).
/*
/*
An UUID is made of 16 bytes, composed of 5 sections:
time_low - 4
time_mid - 2