diff options
Diffstat (limited to 'stdlib.pl')
| -rw-r--r-- | stdlib.pl | 699 |
1 files changed, 0 insertions, 699 deletions
diff --git a/stdlib.pl b/stdlib.pl deleted file mode 100644 index 19b20d0..0000000 --- a/stdlib.pl +++ /dev/null @@ -1,699 +0,0 @@ -:-(module(system, [])). - -% Insert the standard operators - -:-(op(1200, fx, :-)). -:- op(1200, fx, ?-). -:- op(1200, xfx, :-). -:- op(1200, xfx, -->). -:- op(1100, xfy, ;). -:- op(1050, xfy, ->). -:- op(1000, xfy, ','). -:- op(900, fy, \+). -:- op(700, xfx, =). -:- op(700, xfx, \=). -:- op(700, xfx, ==). -:- op(700, xfx, \==). -:- op(700, xfx, @<). -:- op(700, xfx, @=<). -:- op(700, xfx, @>). -:- op(700, xfx, @>=). -:- op(700, xfx, =..). -:- op(700, xfx, is). -:- op(700, xfx, =:=). -:- op(700, xfx, =\=). -:- op(700, xfx, <). -:- op(700, xfx, =<). -:- op(700, xfx, >). -:- op(700, xfx, >=). -:- op(600, xfy, :). -:- op(500, yfx, +). -:- op(500, yfx, -). -:- op(500, yfx, /\). -:- op(500, yfx, \/). -:- op(400, yfx, *). -:- op(400, yfx, /). -:- op(400, yfx, //). -:- op(400, yfx, rem). -:- op(400, yfx, mod). -:- op(400, yfx, <<). -:- op(400, yfx, >>). -:- op(200, xfx, **). -:- op(200, xfy, ^). -:- op(200, fy, -). -:- op(200, fy, \). - -% 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, []). - -flush_output :- - current_output(S), - flush_output(S). - -stream_property(S, P) :- - stream_properties(Props), - member(prop(S,P), Props). - -at_end_of_stream :- - current_input(S), - stream_property(S, end_of_stream(E)), - !, - (E = at ; E = past), - !. - -at_end_of_stream(S_or_a) :- - ( atom(S_or_a) - -> stream_property(S, alias(S_or_a)) - ; S = S_or_a - ), - stream_property(S, end_of_stream(E)), - !, - (E = at; E = past), - !. - -% 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 -parse_read_option(variables(Vs), options(variables, Vs)). -parse_read_option(variable_names(VNames), option(variable_names, VNames)). -parse_read_option(singletons(S), options(singletons, S)). - -parse_read_options([], []). -parse_read_options([Op|Rest], [OpParsed|RestParsed]) :- - is_nonvar(Op), - parse_read_options(Rest, RestParsed), - ( parse_read_option(Op, OpParsed) - -> true - ; domain_error(read_option, Op) - ). - -read_term(S, Term, Options) :- - is_nonvar(Options), - is_list(Options), - parse_read_options(Options, ParsedOptions), - '$read_term'(S, Term, ParsedOptions). - -read_term(Term, Options) :- - current_input(S), - read_term(S, Term, Options). - -read(Term) :- - current_input(S), - read_term(S, Term, []). - -read(S, Term) :- - read_term(S, Term, []). - -parse_write_option(quoted(true), option(quoted, 1)). -parse_write_option(quoted(false), option(quoted, 0)). -parse_write_option(ignore_ops(true), option(ignore_ops, 1)). -parse_write_option(ignore_ops(false), option(ignore_ops, 0)). -parse_write_option(numbervars(true), option(numbervars, 1)). -parse_write_option(numbervars(false), option(numbervars, 0)). - -parse_write_options([], []). -parse_write_options([Op|Rest], [OpParsed|RestParsed]) :- - is_nonvar(Op), - parse_write_options(Rest, RestParsed), - ( parse_write_option(Op, OpParsed) - -> true - ; domain_error(write_option, Op) - ). -write_term(S, Term, Options) :- - is_nonvar(Options), - is_list(Options), - parse_write_options(Options, ParsedOptions), - '$write_term'(S, Term, ParsedOptions). - - -write_term(Term, Options) :- - current_output(S), - write_term(S, Term, Options). - -write(Term) :- - current_output(S), - write_term(S, Term, [numbervars(true)]). - -write(S, Term) :- - 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). - -append([], Ys, Ys). -append([X|Xs], Ys, [X|Zs]) :- - append(Xs, Ys, Zs). - -length([], 0). -length([_|T], Len) :- - length(T, Len0), - Len is Len0 + 1. - -unique([], []). -unique([H|T], [H|Rest]) :- - findall(_, (member(X, T), X == H), []), - !, - unique(T, Rest). -unique([H|T], Rest) :- - unique(T, Rest). - -union(A, B, C) :- - append(A, B, C0), - unique(C0, C). - -difference(A, B, Diff) :- - append(A, B, AB), - unique_in(AB, AB, Diff). - -unique_in([], _, []). -unique_in([H|T], L, [H|Rest]) :- - findall(_, (member(X, L), X == H), [_]), - !, - unique_in(T, L, Rest). -unique_in([H|T], L, Rest) :- - unique_in(T, L, Rest). - -include(_, [], []). -include(Goal, [X|Xs], Included) :- - Goal =.. L, - append(L, [X], L1), - G =.. L1, - ( call(G) - -> Included = [X|Included0] - ; Included = Included0 - ), - include(Goal, Xs, Included0). - -% 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). - -atomic(T) :- atom(T) ; integer(T) ; float(T). - -% type assertions (throws an error if false) - -is_atom(T) :- atom(T), ! ; type_error(atom, T). - -is_atom_or_var(T) :- (atom(T) ; var(T)), ! ; type_error(atom, T). - -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). - -is_list(T) :- list(T), ! ; type_error(list, T). - -is_integer(T) :- integer(T), ! ; type_error(integer, T). - -is_predicate_indicator(T) :- (nonvar(T), T = N/A, integer(A), atom(N), !) ; type_error(predicate_indicator, 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) :- - system:retract('find all'(Item)), - !, - findall_collect(Item, Acc, Instances). -findall_collect([], Instances, Instances). -findall_collect(solution(T), Acc, Instances) :- - findall_collect([T|Acc], Instances). - -bagof(Template, Goal, Instances) :- - free_variable_set(Goal, Template, Witness), - iterated_goal(Goal, G), - findall(Witness+Template, G, S), - bagof_loop(Witness, S, Instances). - -bagof_loop(Witness, S, Instances) :- - [W+T|_] = S, - bagof_wt_list(S, W+T, WT_list), - bagof_split(WT_list, W_list, T_list), - ( bagof_unify_list(Witness, W_list), Instances = T_list - ; bagof_next_s(S, WT_list, S_next), bagof_loop(Witness, S_next, Instances) - ). - -bagof_wt_list([], _, []). -bagof_wt_list([W+T|Tail], W0+T0, Rest) :- - copy_term(W+T, W1+T1), - bagof_wt_list(Tail, W0+T0, Rest0), - ( variant(W1, W0) - -> Rest = [W1+T1|Rest0] - ; Rest = Rest0 - ). - -copy_terms_list([], []). -copy_terms_list([H|T], [HH|TT]) :- - copy_term(H, HH), - copy_terms_list(T, TT). -bagof_split([], [], []). -bagof_split([WW+TT|RestWT], [WW|RestW], [TT|RestT]) :- - bagof_split(RestWT, RestW, RestT). - -bagof_unify_list(W, []). -bagof_unify_list(W, [W|T]) :- bagof_unify_list(W, T). - -bagof_next_s([], _, []). -bagof_next_s([H|T], WT_list, Rest) :- - bagof_next_s(T, WT_list, Rest0), - ( findall(_, (member(X, WT_list), variant(X, H)), []) - -> Rest = [H|Rest0] - ; Rest = Rest0 - ). - -setof(Template, Goal, Instances) :- - bagof(Template, Goal, Instances_list), - sort(Instances_list, Instances). - -% misc helpers - -variable_set(Term, []) :- - atomic(Term). -variable_set(Term, [Term]) :- - var(Term). -variable_set(Term, Vars) :- - compound(Term), - Term =.. [_|Args], - variable_set(Args, [], Vars0), - unique(Vars0, Vars). - -variable_set([], Acc, Acc). -variable_set([Arg|Rest], Acc0, Result) :- - variable_set(Arg, VarSet), - append(Acc0, VarSet, Acc), - variable_set(Rest, Acc, Result). - -existential_variable_set(Term, []) :- - (atomic(Term) ; var(Term)), - !. -existential_variable_set(V^G, Vars) :- - !, - existential_variable_set(G, Vars0), - variable_set(V, Vars1), - union(Vars0, Vars1, Vars). -existential_variable_set(_, []). - -free_variable_set(T, V, Vars) :- - variable_set(T, TVars), - variable_set(V, VVars), - existential_variable_set(T, TExVars), - union(VVars, TExVars, BV), - difference(TVars, BV, Vars). - -iterated_goal(Goal, T) :- - compound(Goal), - _^G = Goal, - !, - iterated_goal(G, T). -iterated_goal(G, G). - -variant(T1, T2) :- - var(T1), var(T2), !. -variant(T1, T2) :- - compound(T1), - compound(T2), - !, - T1 =.. [Name|Args1], - T2 =.. [Name|Args2], - variant_list(Args1, Args2). -variant(T1, T2) :- - T1 == T2. - -variant_list([], []). -variant_list([H1|T1], [H2|T2]) :- - variant(H1, H2), - variant_list(T1, T2). - -% Sorting, which also removes duplicates (should be implemented in C for speed I think). - -sort(Ls0, Ls) :- - append(Lefts, [A,B|Rights], Ls0), - A @> B, - !, - append(Lefts, [B,A|Rights], Ls1), - sort(Ls1, Ls). -sort(Ls0, Ls) :- - append(Lefts, [A,B|Rights], Ls0), - A == B, - !, - append(Lefts, [A|Rights], Ls1), - sort(Ls1, Ls). -sort(Ls, Ls). - -% Atomic term processing - -atom_concat(A1, A2, A3) :- - is_atom_or_var(A1), - is_atom_or_var(A2), - is_atom_or_var(A3), - atom(A1), atom(A2), - !, - atom_codes(A1, Codes1), - atom_codes(A2, Codes2), - append(Codes1, Codes2, Codes), - atom_codes(A3, Codes). -atom_concat(A1, A2, A3) :- - is_atom_or_var(A1), - is_atom_or_var(A2), - is_atom_or_var(A3), - atom(A3), - !, - atom_codes(A3, Codes), - append(Codes1, Codes2, Codes), - atom_codes(A1, Codes1), - atom_codes(A2, Codes2). -atom_concat(A1, A2, A3) :- - instantiation_error. - -% Character input/output - -get_char(Char) :- - current_input(S), - get_char(S, Char). - -get_code(Code) :- - current_input(S), - get_code(S, Code). - -get_code(S, Code) :- - get_char(S, Char), - ( Char = end_of_file - -> Code = -1 - ; char_code(Char, Code) - ). - -peek_char(Char) :- - current_input(S), - peek_char(S, Char). - -peek_code(Code) :- - current_input(S), - peek_code(S, Code). - -peek_code(S, Code) :- - peek_char(S, Char), - ( Char = end_of_file - -> Code = -1 - ; char_code(Char, Code) - ). - -put_char(Char) :- - current_output(S), - put_char(S, Char). - -put_code(Code) :- - current_output(S), - put_code(S, Code). - -put_code(S, Code) :- - char_code(Char, Code), - put_char(S, Char). - -nl :- - current_output(S), - nl(S). - -nl(S) :- - put_char(S, ' -'). % This should really be \n - -% flags -set_prolog_flag(Flag, Value) :- - is_nonvar(Flag), - is_nonvar(Value), - is_atom(Flag), - is_prolog_flag(Flag), - is_appropriate_flag_value(Flag, Value), - is_modifiable_flag(Flag), - '$set_prolog_flag'(Flag, Value). - -current_prolog_flag(Flag, Value) :- - is_atom_or_var(Flag), - ( atom(Flag) - -> is_prolog_flag(Flag) - ; true - ), - current_prolog_flags(FlagsAndValues), - member(flag(Flag, Value), FlagsAndValues). - -is_prolog_flag(Flag) :- - member(Flag, - [ bounded - , max_integer - , min_integer - , integer_rounding_function - , char_conversion - , debug - , max_arity - , unknown - , double_quotes]), - ! - ; domain_error(prolog_flag, Flag). - -is_modifiable_flag(Flag) :- - member(Flag, [char_conversion, debug, unknown, double_quotes]), - ! - ; permission_error(modify, flag, Flag). - -is_appropriate_flag_value(Flag, Value) :- - appropriate_flag_values(Flag, Values), - member(Value, Values), - ! - ; domain_error(flag_value, Flag + Value). - -appropriate_flag_values(bounded, [true, false]). -appropriate_flag_values(max_integer, [Val]) :- - current_prolog_flag(max_integer, Val). -appropriate_flag_values(min_integer, [Val]) :- - current_prolog_flag(min_integer, Val). -appropriate_flag_values(integer_rounding_function, [down, toward_zero]). -appropriate_flag_values(char_conversion, [on, off]). -appropriate_flag_values(debug, [on, off]). -appropriate_flag_values(max_arity, [Val]) :- - current_prolog_flag(max_arity). -appropriate_flag_values(unknown, [error, fail, warning]). -appropriate_flag_values(double_quotes, [chars, codes, atom]). - -% Operator table modification and inspection - -op(Priority, Op_specifier, Operator) :- - is_nonvar(Priority), - is_integer(Priority), - is_nonvar(Op_specifier), - is_atom(Op_specifier), - ( operator_priority(Priority), ! - ; domain_error(operator_priority, Priority) - ), - ( operator_specifier(Op_specifier), ! - ; domain_error(operator_specifier, Op_specifier) - ), - is_nonvar(Operator), - ( atom(Operator) - -> Ops = [Operator] - ; Ops = Operator - ), - is_list(Ops), - op_helper(Priority, Op_specifier, Ops). - -op_helper(Priority, Op_specifier, []). -op_helper(Priority, Op_specifier, [Op|Ops]) :- - is_nonvar(Op), - is_atom(Op), - '$op'(Priority, Op_specifier, Op), - op_helper(Priority, Op_specifier, Ops). - -operator_priority(P) :- - integer(P), - P >= 0, - P =< 1200. - -operator_specifier(S) :- - member(S, [xf, yf, xfx, xfy, yfx, fx, fy]). - -current_op(Priority, Op_specifier, Operator) :- - ( (var(Priority) ; operator_priority(Priority)), ! - ; domain_error(operator_priority, Priority) - ), - ( (var(Op_specifier) ; operator_specifier(Op_specifier)), ! - ; domain_error(operator_specifier, Op_specifier) - ), - is_atom_or_var(Operator), - current_ops(Operators), - member(op(Priority, Op_specifier, Operator), Operators). - -% Halting - -halt(X) :- - is_nonvar(X), - is_integer(X), - '$halt'(X). - -halt :- - halt(0). - -% Loading prolog text - -consult(File) :- - loader:load_module_from_file(File). |