ref: 48c0638c7be3f99f2512be42fbb6b3946df26463
dir: /stdlib.pl/
:- module(system, []).
% Logic and control predicates
\+ Goal :- call(Goal), !, fail.
\+ Goal.
once(Goal) :-
call(Goal),
!.
repeat :- true ; repeat.
% Control structures.
If -> Then :-
If, !, Then.
If -> Then ; _ :-
If, !, Then.
_ -> _ ; Else :-
!, Else.
If ; _ :-
If.
_ ; Else :-
Else.
A , B :- A , B.
% Term unification
A = A.
A \= B :-
\+ A = B.
% Comparison of terms using the standard order
A == B :-
compare(=, A, B).
A \== B :-
\+ A == B.
A @< B :-
compare(<, A, B).
A @=< B :-
A == B.
A @=< B :-
A @< B.
A @> B :-
compare(>, A, B).
A @>= B :-
A == B.
A @>= B :-
A @> B.
% Input output
open(SourceSink, Mode, Stream) :-
open(SourceSink, Mode, Stream, []).
close(StreamOrAlias) :-
close(StreamOrAlias, []).
% Standard exceptions
instantiation_error :-
throw(error(instantiation_error, _)).
type_error(ValidType, Culprit) :-
throw(error(type_error(ValidType, Culprit), _)).
domain_error(ValidDomain, Culprit) :-
throw(error(domain_error(ValidDomain, Culprit), _)).
existence_error(ObjectType, Culprit) :-
throw(error(existence_error(ObjectType, Culprit), _)).
permission_error(Operation, PermissionType, Culprit) :-
throw(error(permission_error(Operation, PermissionType, Culprit), _)).
representation_error(Flag) :-
throw(error(representation_error(Flag), _)).
evaluation_error(Error) :-
throw(error(evaluation_error(Error), _)).
resource_error(Resource) :-
throw(error(resource_error(Resource), _)).
syntax_error(Error) :-
throw(error(syntax_error(Error), _)).
% Input and output
read_term(Term, Options) :-
current_input(S),
read_term(S, Term, Options).
read(Term) :-
current_input(S),
read_term(S, Term, []).
write_term(Term, Options) :-
current_output(S),
write_term(S, Term, Options).
write(Term) :-
current_output(S),
write_term(S, Term, [numbervars(true)]).
writeq(Term) :-
current_output(S),
write_term(S, Term, [quoted(true), numbervars(true)]).
writeq(S, Term) :-
write_term(S, Term, [quoted(true), numbervars(true)]).
write_canonical(Term) :-
current_output(S),
write_term(S, Term, [quoted(true), ignore_ops(true)]).
write_canonical(S, Term) :-
write_term(S, Term, [quoted(true), ignore_ops(true)]).
% Arithmetic comparisons defined in terms of >=. This is not the most effective way,
% but it is fine for now.
E1 =:= E2 :-
E1 >= E2,
E2 >= E1.
E1 =\= E2 :-
\+ E1 =:= E2.
E1 < E2 :-
E2 >= E1,
E1 =\= E2.
E1 =< E2 :-
E2 >= E1.
E1 > E2 :-
E2 < E1.
% Clause retrieval and information and removal
clause(Head, Body) :-
clause(Head, Body, Clauses),
member(clause(Head, Body), Clauses).
current_predicate(PI) :-
current_predicate(PI, Predicates),
member(PI, Predicates).
retract(Clause) :-
copy_term(Clause, ClauseCopy),
retract_one(ClauseCopy),
( Clause = ClauseCopy
; retract(Clause)
).
% Basic list predicates
member(X, [X|_]).
member(X, [_|Tail]) :-
member(X, Tail).
% Additional type tests
callable(T) :- atom(T) ; compound(T).
list([]).
list([_|T]) :- list(T).
partial_list(T) :- var(T).
partial_list([_|T]) :- partial_list(T).
% type assertions (throws an error if false)
is_callable(T) :- callable(T), ! ; type_error(callable, T).
is_nonvar(T) :- nonvar(T), ! ; instantiation_error.
is_list_or_partial_list(T) :- (list(T) ; partial_list(T)), ! ; type_error(list, T).
% All solutions
findall(Template, Goal, Instances) :-
is_nonvar(Goal),
is_callable(Goal),
is_list_or_partial_list(Instances),
system:asserta('find all'([])),
call(Goal),
system:asserta('find all'(solution(Template))),
fail.
findall(Template, Goal, Instances) :-
findall_collect([], Instances).
findall_collect(Acc, Instances) :-
retract('find all'(Item)),
!,
findall_collect(Item, Acc, Instances).
findall_collect([], Instances, Instances).
findall_collect(solution(T), Acc, Instances) :-
findall_collect([T|Acc], Instances).