:- op(400, yfx, /). :- module(builtins, [(=)/2, (\=)/2, (\+)/1, (+)/1, (+)/2, (**)/2, (*)/2, (-)/1, (-)/2, (/)/2, (/\)/2, (\/)/2, (is)/2, (xor)/2, (div)/2, (//)/2, (rdiv)/2, (<<)/2, (>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, abolish/1, asserta/1, assertz/1, bagof/3, call_with_inference_limit/3, catch/3, clause/2, current_predicate/1, current_prolog_flag/2, expand_goal/2, expand_term/2, findall/3, findall/4, once/1, repeat/0, retract/1, set_prolog_flag/2, setof/3, setup_call_cleanup/3, term_variables/2, throw/1, true/0, false/0, write/1, write_canonical/1, writeq/1, write_term/2]). /* this is an implementation specific declarative operator used to implement call_with_inference_limit/3 and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice instructions are unchanged. */ :- op(700, fx, non_counted_backtracking). % module resolution operator. :- op(600, xfy, :). user:term_expansion((:- op(Pred, Spec, [Op | OtherOps])), OpResults) :- expand_op_list([Op | OtherOps], Pred, Spec, OpResults). expand_op_list([], _, _, []). expand_op_list([Op | OtherOps], Pred, Spec, [(:- op(Pred, Spec, Op)) | OtherResults]) :- expand_op_list(OtherOps, Pred, Spec, OtherResults). % arithmetic operators. :- op(700, xfx, is). :- op(500, yfx, [+, -]). :- op(400, yfx, *). :- op(200, xfy, **). :- op(500, yfx, [/\, \/, xor]). :- op(400, yfx, [div, //, rdiv]). :- op(400, yfx, [<<, >>, mod, rem]). :- op(200, fy, [+, -]). % arithmetic comparison operators. :- op(700, xfx, [>, <, =\=, =:=, >=, =<]). % conditional operators. :- op(1050, xfy, ->). :- op(1100, xfy, ;). % control. :- op(700, xfx, [=, =.., \=]). :- op(900, fy, \+). % term comparison. :- op(700, xfx, [==, \==, @=<, @>=, @<, @>, =@=, \=@=]). % the maximum arity flag. needs to be replaced with current_prolog_flag(max_arity, MAX_ARITY). max_arity(63). % unify. X = X. true. false :- '$fail'. % dynamic module resolution. Module : Predicate :- ( atom(Module) -> '$module_call'(Module, Predicate) ; throw(error(type_error(atom, Module), (:)/2)) ). % flags. current_prolog_flag(Flag, false) :- Flag == bounded, !. current_prolog_flag(bounded, false). current_prolog_flag(Flag, down) :- Flag == integer_rounding_function, !. current_prolog_flag(integer_rounding_function, down). 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, _) :- Flag == max_integer, !, '$fail'. current_prolog_flag(Flag, _) :- Flag == min_integer, !, '$fail'. current_prolog_flag(Flag, _) :- atom(Flag), throw(error(domain_error(prolog_flag, Flag), current_prolog_flag/2)). % 8.17.2.3 b current_prolog_flag(Flag, _) :- nonvar(Flag), throw(error(type_error(atom, Flag), current_prolog_flag/2)). % 8.17.2.3 a set_prolog_flag(Flag, Value) :- (var(Flag) ; var(Value)), throw(error(instantiation_error, set_prolog_flag/2)). % 8.17.1.3 a, b set_prolog_flag(bounded, false) :- !. % 7.11.1.1 set_prolog_flag(bounded, true) :- !, '$fail'. % 7.11.1.1 set_prolog_flag(bounded, Value) :- throw(error(domain_error(flag_value, bounded + Value), set_prolog_flag/2)). % 8.17.1.3 e set_prolog_flag(max_integer, Value) :- integer(Value), !, '$fail'. % 7.11.1.2 set_prolog_flag(max_integer, Value) :- throw(error(domain_error(flag_value, max_integer + Value), set_prolog_flag/2)). % 8.17.1.3 e set_prolog_flag(min_integer, Value) :- integer(Value), !, '$fail'. % 7.11.1.3 set_prolog_flag(min_integer, Value) :- throw(error(domain_error(flag_value, min_integer + Value), set_prolog_flag/2)). % 8.17.1.3 e set_prolog_flag(integer_rounding_function, down) :- !. % 7.11.1.4 set_prolog_flag(integer_rounding_function, Value) :- throw(error(domain_error(flag_value, integer_rounding_function + Value), set_prolog_flag/2)). % 8.17.1.3 e set_prolog_flag(double_quotes, chars) :- !, '$set_double_quotes'(chars). % 7.11.2.5, list of one-char atoms. set_prolog_flag(double_quotes, atom) :- !, '$set_double_quotes'(atom). % 7.11.2.5, list of one-char atoms. set_prolog_flag(double_quotes, Value) :- throw(error(domain_error(flag_value, double_quotes + Value), set_prolog_flag/2)). % 8.17.1.3 e set_prolog_flag(Flag, _) :- atom(Flag), throw(error(domain_error(prolog_flag, Flag), set_prolog_flag/2)). % 8.17.1.3 d set_prolog_flag(Flag, _) :- throw(error(type_error(atom, Flag), set_prolog_flag/2)). % 8.17.1.3 c % control operators. \+ G :- G, !, false. \+ _. X \= X :- !, false. _ \= _. once(G) :- G, !. repeat. repeat :- repeat. ','(G1, G2) :- '$get_b_value'(B), '$call_with_default_policy'(comma_errors(G1, G2, B)). :- non_counted_backtracking comma_errors/3. comma_errors(G1, G2, B) :- var(G1), throw(error(instantiation_error, (,)/2)). comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)). :- non_counted_backtracking (,)/3. ','(!, CF, B) :- compound(CF), '$call_with_default_policy'(CF = ','(G1, G2)), '$set_cp'(B), '$call_with_default_policy'(comma_errors(G1, G2, B)). ','(!, Atom, B) :- Atom == !, '$set_cp'(B). ','(!, G, B) :- '$set_cp'(B), G. ','(G, CF, B) :- compound(CF), '$call_with_default_policy'(CF = ','(G1, G2)), !, G, '$call_with_default_policy'(comma_errors(G1, G2, B)). ','(G, Atom, B) :- Atom == !, !, G, '$set_cp'(B). ','(G1, G2, _) :- G1, G2. ;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B). :- non_counted_backtracking (;)/3. ;(G1, G4, B) :- compound(G1), '$call_with_default_policy'(G1 = ->(G2, G3)), (G2 -> G3 ; '$set_cp'(B), G4). ;(G1, G2, B) :- G1 == !, '$set_cp'(B), G2. ;(G1, G2, B) :- G2 == !, G1, '$set_cp'(B). ;(G, _, _) :- G. ;(_, G, _) :- G. G1 -> G2 :- '$get_b_value'(B), '$call_with_default_policy'(->(G1, G2, B)). :- non_counted_backtracking (->)/3. ->(G1, G2, B) :- G2 == !, G1, '$set_cp'(B). ->(G1, G2, B) :- G1, '$set_cp'(B), G2. % 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 ) ; R \== [] -> throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b) ; List = [H|T] -> ( var(H), var(Term), % R == [] => List is a proper list. throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 c) ; T \== [], nonvar(H), \+ atom(H), throw(error(type_error(atom, H), (=..)/2)) % 8.5.3.3 d) ; compound(H), T == [], throw(error(type_error(atomic, H), (=..)/2)) % 8.5.3.3 e) ; var(Term), max_arity(M), N - 1 > M, throw(error(representation_error(max_arity), (=..)/2)) % 8.5.3.3 g) ; true ) ; var(Term) -> throw(error(domain_error(non_empty_list, List), (=..)/2)) % 8.5.3.3 f) ; true ). Term =.. List :- '$call_with_default_policy'(univ_errors(Term, List, N)), '$call_with_default_policy'(univ_worker(Term, List, N)). :- non_counted_backtracking univ_worker/3. univ_worker(Term, List, _) :- atomic(Term), !, '$call_with_default_policy'(List = [Term]). univ_worker(Term, [Name|Args], N) :- var(Term), !, '$call_with_default_policy'(Arity is N-1), '$call_with_default_policy'(functor(Term, Name, Arity)), '$call_with_default_policy'(get_args(Args, Term, 1, Arity)). univ_worker(Term, List, _) :- '$call_with_default_policy'(functor(Term, Name, Arity)), '$call_with_default_policy'(get_args(Args, Term, 1, Arity)), '$call_with_default_policy'(List = [Name|Args]). :- non_counted_backtracking get_args/4. get_args(Args, _, _, 0) :- !, '$call_with_default_policy'(Args = []). get_args([Arg], Func, N, N) :- !, '$call_with_default_policy'(arg(N, Func, Arg)). get_args([Arg|Args], Func, I0, N) :- '$call_with_default_policy'(arg(I0, Func, Arg)), '$call_with_default_policy'(I1 is I0 + 1), '$call_with_default_policy'(get_args(Args, Func, I1, N)). % write, write_canonical, writeq, write_term. is_write_option(Functor) :- Functor =.. [Name, Arg], ( Arg == true -> true ; Arg == false -> true ; throw(error(domain_error(write_option, Functor), write_term/2)) ), % 8.14.2.3 e) ( Name == ignore_ops -> true ; Name == quoted -> true ; Name == numbervars -> true ; throw(error(domain_error(write_option, Functor), write_term/2)) ). % 8.14.2.3 e) inst_member_or([X|Xs], Y, _) :- ( nonvar(X), is_write_option(X) -> ( Y = X, ! ; inst_member_or(Xs, Y, _) ) ; throw(instantiation_error) ). % 8.14.2.3 b) inst_member_or([], Y, Y). write_term(Term, Options) :- '$skip_max_list'(_, -1, Options, Options0), ( Options0 == [] -> true ; throw(error(type_error(list, Options), write_term/2)) ), % 8.14.2.3 c) inst_member_or(Options, ignore_ops(IgnoreOps), ignore_ops(false)), inst_member_or(Options, numbervars(NumberVars), numbervars(false)), inst_member_or(Options, quoted(Quoted), quoted(false)), '$write_term'(Term, IgnoreOps, NumberVars, Quoted). write(Term) :- write_term(Term, [numbervars(true)]). write_canonical(Term) :- write_term(Term, [ignore_ops(true), quoted(true)]). writeq(Term) :- write_term(Term, [quoted(true), numbervars(true)]). % expand_goal. expand_goal(Term0, Term) :- '$expand_goal'(Term0, Term). % expand_term. expand_term(Term0, Term) :- '$expand_term'(Term0, Term). % term_variables. can_be(Type, Term) :- error:can_be(Type, Term). term_variables(Term, Vars) :- catch(can_be(list, Vars), error(E, Ctx), ( ( var(Ctx) -> Ctx = term_variables/2 ; true ), throw(error(E, Ctx)) ) ), '$term_variables'(Term, Vars). % setup_call_cleanup. setup_call_cleanup(S, G, C) :- '$get_b_value'(B), S, '$set_cp_by_default'(B), '$get_current_block'(Bb), ( '$call_with_default_policy'(var(C)) -> throw(error(instantiation_error, setup_call_cleanup/3)) ; '$call_with_default_policy'(scc_helper(C, G, Bb)) ). :- non_counted_backtracking scc_helper/3. scc_helper(C, G, Bb) :- '$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G), ( '$check_cp'(Cp) -> '$reset_block'(Bb), '$call_with_default_policy'(run_cleaners_without_handling(Cp)) ; '$call_with_default_policy'(true) ; '$reset_block'(NBb), '$fail'). scc_helper(_, _, Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), '$call_with_default_policy'(run_cleaners_with_handling), '$erase_ball', '$call_with_default_policy'(throw(Ball)). scc_helper(_, _, _) :- '$get_cp'(Cp), '$call_with_default_policy'(run_cleaners_without_handling(Cp)), '$fail'. :- non_counted_backtracking run_cleaners_with_handling/0. run_cleaners_with_handling :- '$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). run_cleaners_with_handling :- '$restore_cut_policy'. :- non_counted_backtracking run_cleaners_without_handling/1. run_cleaners_without_handling(Cp) :- '$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B), '$call_with_default_policy'(run_cleaners_without_handling(Cp)). run_cleaners_without_handling(Cp) :- '$set_cp_by_default'(Cp), '$restore_cut_policy'. % call_with_inference_limit call_with_inference_limit(G, L, R) :- '$get_current_block'(Bb), '$get_b_value'(B), '$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)), '$remove_call_policy_check'(B). :- 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), '$inference_level'(R, B), '$remove_inference_counter'(B, Count1), '$call_with_default_policy'(is(Diff, L - (Count1 - Count0))), '$call_with_default_policy'(end_block(B, Bb, NBb, Diff)). call_with_inference_limit(_, _, R, Bb, B) :- '$reset_block'(Bb), '$remove_inference_counter'(B, _), ( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp) ; '$remove_call_policy_check'(B), '$fail' ), '$erase_ball', '$call_with_default_policy'(handle_ile(B, Ball, R)). :- non_counted_backtracking end_block/4. end_block(_, Bb, NBb, L) :- '$clean_up_block'(NBb), '$reset_block'(Bb). end_block(B, Bb, NBb, L) :- '$install_inference_counter'(B, L, _), '$reset_block'(NBb), '$fail'. :- non_counted_backtracking handle_ile/3. handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !. handle_ile(B, E, _) :- '$remove_call_policy_check'(B), '$call_with_default_policy'(throw(E)). % exceptions. catch(G,C,R) :- '$get_current_block'(Bb), '$call_with_default_policy'(catch(G,C,R,Bb)). :- non_counted_backtracking catch/4. catch(G,C,R,Bb) :- '$install_new_block'(NBb), call(G), '$call_with_default_policy'(end_block(Bb, NBb)). catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), '$call_with_default_policy'(handle_ball(Ball, C, R)). :- non_counted_backtracking end_block/2. end_block(Bb, NBb) :- '$clean_up_block'(NBb), '$reset_block'(Bb). end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'. :- non_counted_backtracking handle_ball/3. handle_ball(C, C, R) :- !, '$erase_ball', call(R). handle_ball(_, _, _) :- '$unwind_stack'. throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'. :- non_counted_backtracking '$iterate_find_all'/4. '$iterate_find_all'(Template, Goal, _, LhOffset) :- call(Goal), '$copy_to_lh'(LhOffset, Template), '$fail'. '$iterate_find_all'(_, _, Solutions, LhOffset) :- '$truncate_if_no_lh_growth'(LhOffset), '$get_lh_from_offset'(LhOffset, Solutions). truncate_lh_to(LhLength) :- '$truncate_lh_to'(LhLength). check_for_compat_list(L, PI) :- ( nonvar(L), L \= [_|_], throw(error(type_error(list, L), PI)) ; true ). findall(Template, Goal, Solutions) :- check_for_compat_list(Solutions, findall/3), '$lh_length'(LhLength), '$call_with_default_policy'(catch('$iterate_find_all'(Template, Goal, Solutions, LhLength), Error, ( truncate_lh_to(LhLength), throw(Error) ))). :- non_counted_backtracking '$iterate_find_all_diff'/4. '$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :- call(Goal), '$copy_to_lh'(LhOffset, Template), '$fail'. '$iterate_find_all_diff'(_, _, Solutions0, Solutions1, LhOffset) :- '$truncate_if_no_lh_growth_diff'(LhOffset, Solutions1), '$get_lh_from_offset_diff'(LhOffset, Solutions0, Solutions1). findall(Template, Goal, Solutions0, Solutions1) :- check_for_compat_list(Solutions0, findall/4), check_for_compat_list(Solutions1, findall/4), '$lh_length'(LhLength), '$call_with_default_policy'(catch('$iterate_find_all_diff'(Template, Goal, Solutions0, Solutions1, LhLength), Error, ( truncate_lh_to(LhLength), throw(Error) ))). set_difference([X|Xs], [Y|Ys], Zs) :- X == Y, !, set_difference(Xs, [Y|Ys], Zs). set_difference([X|Xs], [Y|Ys], [X|Zs]) :- X @< Y, !, set_difference(Xs, [Y|Ys], Zs). set_difference([X|Xs], [Y|Ys], Zs) :- X @> Y, !, set_difference([X|Xs], Ys, Zs). set_difference([], _, []) :- !. set_difference(Xs, [], Xs). group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :- V1 =@= V2, !, V1 = V2, group_by_variant(Pairs, V2-S2, Solutions, Pairs0). group_by_variant(Pairs, _, [], Pairs). group_by_variants([V-S|Pairs], [V-Solution|Solutions]) :- group_by_variant([V-S|Pairs], V-S, Solution, Pairs0), group_by_variants(Pairs0, Solutions). group_by_variants([], []). iterate_variants([V-Solution|GroupSolutions], V, Solution). iterate_variants([_|GroupSolutions], Ws, Solution) :- iterate_variants(GroupSolutions, Ws, Solution). bagof(Template, Goal, Solution) :- check_for_compat_list(Solution, bagof/3), term_variables(Template, TemplateVars0), term_variables(Goal, GoalVars0), sort(TemplateVars0, TemplateVars), sort(GoalVars0, GoalVars), set_difference(GoalVars, TemplateVars, Witnesses), findall(Witnesses-Template, Goal, PairedSolutions0), keysort(PairedSolutions0, PairedSolutions), group_by_variants(PairedSolutions, GroupedSolutions), iterate_variants(GroupedSolutions, Witnesses, Solution). iterate_variants_and_sort([V-Solution0|GroupSolutions], V, Solution) :- sort(Solution0, Solution). iterate_variants_and_sort([_|GroupSolutions], Ws, Solution) :- iterate_variants_and_sort(GroupSolutions, Ws, Solution). setof(Template, Goal, Solution) :- check_for_compat_list(Solution, setof/3), term_variables(Template, TemplateVars0), term_variables(Goal, GoalVars0), sort(TemplateVars0, TemplateVars), sort(GoalVars0, GoalVars), set_difference(GoalVars, TemplateVars, Witnesses), findall(Witnesses-Template, Goal, PairedSolutions0), keysort(PairedSolutions0, PairedSolutions), group_by_variants(PairedSolutions, GroupedSolutions), iterate_variants_and_sort(GroupedSolutions, Witnesses, Solution). % Clause retrieval and information. '$clause_body_is_valid'(B) :- ( var(B) -> true ; functor(B, Name, _) -> ( atom(Name), Name \= '.' -> true ; throw(error(type_error(callable, B), clause/2)) ) ; throw(error(type_error(callable, B), clause/2)) ). clause(H, B) :- ( var(H) -> throw(error(instantiation_error, clause/2)) ; functor(H, Name, Arity) -> ( Name == '.' -> throw(error(type_error(callable, H), clause/2)) %% '$no_such_predicate' fails if H is not callable. ; '$no_such_predicate'(H) -> '$fail' ; '$head_is_dynamic'(H) -> '$clause_body_is_valid'(B), '$get_clause'(H, B) ; throw(error(permission_error(access, private_procedure, Name/Arity), clause/2)) ) ; throw(error(type_error(callable, H), clause/2)) ). call_asserta(Head, Body, Name, Arity) :- '$clause_body_is_valid'(Body), functor(VarHead, Name, Arity), findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses), '$asserta'((Head :- Body), Clauses, Name, Arity). asserta_clause(Head, Body) :- ( var(Head) -> throw(error(instantiation_error, asserta/1)) ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> ( '$no_such_predicate'(Head) -> call_asserta(Head, Body, Name, Arity) ; '$head_is_dynamic'(Head) -> call_asserta(Head, Body, Name, Arity) ; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1)) ) ; throw(error(type_error(callable, Head), asserta/1)) ). asserta(Clause) :- ( Clause \= (_ :- _) -> Head = Clause, Body = true, asserta_clause(Head, Body) ; Clause = (Head :- Body) -> asserta_clause(Head, Body) ). call_assertz(Head, Body, Name, Arity) :- '$clause_body_is_valid'(Body), functor(VarHead, Name, Arity), findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses), '$assertz'((Head :- Body), Clauses, Name, Arity). assertz_clause(Head, Body) :- ( var(Head) -> throw(error(instantiation_error, assertz/1)) ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> ( '$no_such_predicate'(Head) -> call_assertz(Head, Body, Name, Arity) ; '$head_is_dynamic'(Head) -> call_assertz(Head, Body, Name, Arity) ; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1)) ) ; throw(error(type_error(callable, Head), assertz/1)) ). assertz(Clause) :- ( Clause \= (_ :- _) -> Head = Clause, Body = true, assertz_clause(Head, Body) ; Clause = (Head :- Body) -> assertz_clause(Head, Body) ). first_match_index([Clause0 | Clauses], Clause1, N0, N) :- ( Clause0 \= Clause1 -> N1 is N0 + 1, first_match_index(Clauses, Clause1, N1, N) ; N0 = N, Clause0 = Clause1 ). retract_clauses([Clause|Clauses0], Head, Body, Name, Arity) :- functor(VarHead, Name, Arity), findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses1), first_match_index(Clauses1, (Head :- Body), 0, N), ( Clauses0 == [] -> ! ; true ), '$retract_clause'(Name, Arity, N, Clauses1). retract_clauses([_|Clauses0], Head, Body, Name, Arity) :- retract_clauses(Clauses0, Head, Body, Name, Arity). call_retract(Head, Body, Name, Arity) :- findall((Head :- Body), clause(Head, Body), Clauses), retract_clauses(Clauses, Head, Body, Name, Arity). retract_clause(Head, Body) :- ( var(Head) -> throw(error(instantiation_error, retract/1)) ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> ( '$head_is_dynamic'(Head) -> call_retract(Head, Body, Name, Arity) ; '$no_such_predicate'(Head) -> '$fail' ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1)) ) ; throw(error(type_error(callable, Head), retract/1)) ). retract(Clause) :- ( Clause \= (_ :- _) -> Head = Clause, Body = true, retract_clause(Head, Body) ; Clause = (Head :- Body) -> retract_clause(Head, Body) ). abolish(Pred) :- ( var(Pred) -> throw(error(instantiation_error), abolish/1) ; Pred = Name/Arity -> ( var(Name) -> throw(error(instantiation_error, abolish/1)) ; var(Arity) -> throw(error(instantiation_error, abolish/1)) ; integer(Arity) -> ( \+ atom(Name) -> throw(error(type_error(atom, Name), abolish/1)) ; Arity < 0 -> throw(domain_error(not_less_than_zero, Arity), abolish/1) ; max_arity(N), Arity > N -> throw(representation_error(max_arity), abolish/1) ; functor(Head, Name, Arity) -> ( '$no_such_predicate'(Head) -> true ; '$head_is_dynamic'(Head) -> '$abolish_clause'(Name, Arity) ; throw(error(permission_error(modify, static_procedure, Pred), abolish/1)) ) ) ; throw(error(type_error(integer, Arity), abolish/1)) ) ; throw(error(type_error(predicate_indicator, Pred), abolish/1)) ). match_builtins(acyclic_term, 1). match_builtins(arg, 3). match_builtins(compare, 3). match_builtins(cyclic_term, 1). match_builtins(@>, 2). match_builtins(@<, 2). match_builtins(@>=, 2). match_builtins(@=<, 2). match_builtins(\\=@=, 2). match_builtins(=@=, 2). match_builtins(copy_term, 2). match_builtins(==, 2). match_builtins(functor, 3). match_builtins(ground, 1). match_builtins(is, 2). match_builtins(keysort, 2). match_builtins(nl, 0). match_builtins(\\==, 2). match_builtins(is_partial_string, 1). match_builtins(partial_string, 2). match_builtins(read, 1). match_builtins(sort, 2). match_builtins(>, 2). match_builtins(<, 2). match_builtins(>=, 2). match_builtins(=<, 2). match_builtins(=\\=, 2). match_builtins(=:=, 2). match_builtins(atom, 1). match_builtins(atomic, 1). match_builtins(compound, 1). match_builtins(integer, 1). match_builtins(rational, 1). match_builtins(string, 1). match_builtins(float, 1). match_builtins(nonvar, 1). match_builtins(var, 1). match_builtins(call, N) :- between:between(0, 63, N). '$iterate_predicate_list'([Name/Arity|Preds], Name/Arity). '$iterate_predicate_list'([_|Preds], Pred) :- '$iterate_predicate_list'(Preds, Pred). '$iterate_predicate_list'([], Name/Arity) :- match_builtins(Name, Arity). current_predicate(Pred) :- ( var(Pred) -> throw(error(type_error(predicate_indicator, Pred), current_predicate/1)) ; Pred = _ / _ -> ( '$get_current_predicate_list'(Ls), '$iterate_predicate_list'(Ls, Pred) ) ; throw(error(type_error(predicate_indicator, Pred), current_predicate/1)) ).