inline metacalls

This commit is contained in:
Mark Thom
2022-07-12 22:39:50 -06:00
parent c7e1f5d568
commit 1ffbf63d20
44 changed files with 2952 additions and 1414 deletions

View File

@@ -1,7 +1,7 @@
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, !/0, (',')/2, (->)/2,
(;)/2, (=..)/2, (:)/2, (:)/3, (:)/4, (:)/5,
(;)/2, (=..)/2, /* (:)/2, (:)/3, (:)/4, (:)/5,
(:)/6, (:)/7, (:)/8, (:)/9, (:)/10, (:)/11,
(:)/12, abolish/1, asserta/1, assertz/1,
(:)/12, */ abolish/1, asserta/1, assertz/1,
at_end_of_stream/0, at_end_of_stream/1,
atom_chars/2, atom_codes/2, atom_concat/3,
atom_length/2, bagof/3, call/1, call/2, call/3,
@@ -41,82 +41,87 @@ false :- '$fail'.
% Once Scryer is bootstrapped, each is replaced with a version that
% uses expand_goal to pass the expanded goal along to '$call'.
call(G) :- '$call'(G).
call(_).
call(G, A) :- '$call'(G, A).
call(_, _).
call(G, A, B) :- '$call'(G, A, B).
call(_, _, _).
call(G, A, B, C) :- '$call'(G, A, B, C).
call(_, _, _, _).
call(G, A, B, C, D) :- '$call'(G, A, B, C, D).
call(_, _, _, _, _).
call(G, A, B, C, D, E) :- '$call'(G, A, B, C, D, E).
call(_, _, _, _, _, _).
call(G, A, B, C, D, E, F) :- '$call'(G, A, B, C, D, E, F).
call(_, _, _, _, _, _, _).
call(G, A, B, C, D, E, F, G) :- '$call'(G, A, B, C, D, E, F, G).
call(_, _, _, _, _, _, _, _).
call(G, A, B, C, D, E, F, G, H) :- '$call'(G, A, B, C, D, E, F, G, H).
call(_, _, _, _, _, _, _, _, _).
% 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2) :-
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3) :-
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
( atom(Module) -> '$module_call'(A4, Module, Predicate, A1, A2, A3)
; 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3, A4, A5)
; 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3, A4, A5, A6)
; 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3, A4, A5, A6, A7)
; 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8)
; 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9)
; 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)
( atom(Module) -> '$module_call'(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10)
; throw(error(type_error(atom, Module), (:)/2))
).
*/
:- meta_predicate catch(0, ?, 0).
% flags.
current_prolog_flag(Flag, Value) :- Flag == max_arity, !, Value = 1023.
@@ -185,7 +190,7 @@ fail :- '$fail'.
:- meta_predicate \+(0).
\+ G :- '$call'(G), !, false.
\+ G :- call(G), !, false.
\+ _.
@@ -195,7 +200,7 @@ _ \= _.
:- meta_predicate once(0).
once(G) :- '$call'(G), !.
once(G) :- call(G), !.
repeat.
@@ -216,17 +221,17 @@ G1 -> G2 :- control_entry_point((G1 -> G2)).
staggered_if_then(G1, G2) :-
'$get_staggered_cp'(B),
'$call'(G1),
call(G1),
'$set_cp'(B),
'$call'(G2).
call(G2).
G1 ; G2 :- control_entry_point((G1 ; G2)).
:- non_counted_backtracking staggered_sc/2.
staggered_sc(G, _) :- '$call'(G).
staggered_sc(_, G) :- '$call'(G).
staggered_sc(G, _) :- call(G).
staggered_sc(_, G) :- call(G).
!.
@@ -257,7 +262,7 @@ control_entry_point_(G) :-
:- non_counted_backtracking cont_list_to_goal/2.
cont_list_goal([Cont], Cont) :- !.
cont_list_goal(Conts, builtins:dispatch_call_list(Conts)).
cont_list_goal(Conts, '$call'(builtins:dispatch_call_list(Conts))).
:- non_counted_backtracking module_qualified_cut/1.
@@ -289,7 +294,7 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1),
Cont = builtins:staggered_sc(Cont0, Cont1),
Cont = '$call'(builtins:staggered_sc(Cont0, Cont1)),
Conts = []
; functor(Gs, ->, 2) ->
arg(1, Gs, G1),
@@ -298,10 +303,10 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2),
Cont = builtins:staggered_if_then(Cont1, Cont2),
Cont = '$call'(builtins:staggered_if_then(Cont1, Cont2)),
Conts = []
; ( Gs == ! ; module_qualified_cut(Gs) ) ->
Cont = builtins:set_cp(B),
Cont = '$call'(builtins:set_cp(B)),
Conts = []
; Cont = Gs,
Conts = []
@@ -318,56 +323,56 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
dispatch_call_list([]).
dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)),
'$call_with_inference_counting'('$call'(G6)),
'$call_with_inference_counting'('$call'(G7)),
'$call_with_inference_counting'('$call'(G8)),
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)),
'$call_with_inference_counting'(call(G6)),
'$call_with_inference_counting'(call(G7)),
'$call_with_inference_counting'(call(G8)),
dispatch_call_list(Gs).
dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)),
'$call_with_inference_counting'('$call'(G6)),
'$call_with_inference_counting'('$call'(G7)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)),
'$call_with_inference_counting'(call(G6)),
'$call_with_inference_counting'(call(G7)).
dispatch_call_list([G1,G2,G3,G4,G5,G6]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)),
'$call_with_inference_counting'('$call'(G6)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)),
'$call_with_inference_counting'(call(G6)).
dispatch_call_list([G1,G2,G3,G4,G5]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)).
dispatch_call_list([G1,G2,G3,G4]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)).
dispatch_call_list([G1,G2,G3]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)).
dispatch_call_list([G1,G2]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)).
dispatch_call_list([G1]) :-
'$call_with_inference_counting'('$call'(G1)).
'$call_with_inference_counting'(call(G1)).
% univ.
@@ -444,7 +449,7 @@ get_args([Arg|Args], Func, I0, N) :-
get_args(Args, Func, I1, N).
:- meta_predicate parse_options_list(?, 0, ?, ?, ?).
:- meta_predicate parse_options_list(?, 2, ?, ?, ?).
parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
'$skip_max_list'(_, _, Options, Tail),
@@ -455,7 +460,10 @@ parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
; Tail \== [] ->
throw(error(type_error(list, Options), Stub)) % 8.11.5.3e)
),
( lists:maplist(nonvar, Options),
( lists:maplist('$call'(nonvar), Options), % need '$call' because
% maplist isn't
% declared as a
% meta-predicate yet
catch(lists:maplist(Selector, Options, OptionPairs0),
error(E, _),
builtins:throw(error(E, Stub))) ->
@@ -619,8 +627,6 @@ term_variables(Term, Vars) :-
% exceptions.
:- meta_predicate catch(0, ?, 0).
:- non_counted_backtracking catch/3.
catch(G,C,R) :-
@@ -633,7 +639,7 @@ catch(G,C,R) :-
catch(G,C,R,Bb) :-
'$install_new_block'(NBb),
'$call_with_inference_counting'('$call'(G)),
'$call_with_inference_counting'(call(G)),
end_block(Bb, NBb).
catch(G,C,R,Bb) :-
'$reset_block'(Bb),
@@ -655,7 +661,7 @@ end_block(Bb, NBb) :-
handle_ball(C, C, R) :-
!,
'$erase_ball',
'$call'(R).
call(R).
handle_ball(_, _, _) :-
'$unwind_stack'.
@@ -671,7 +677,7 @@ throw(Ball) :-
:- non_counted_backtracking '$iterate_find_all'/4.
'$iterate_find_all'(Template, Goal, _, LhOffset) :-
'$call_with_inference_counting'('$call'(Goal)),
'$call_with_inference_counting'(call(Goal)),
'$copy_to_lh'(LhOffset, Template),
'$fail'.
'$iterate_find_all'(_, _, Solutions, LhOffset) :-
@@ -697,7 +703,7 @@ findall(Template, Goal, Solutions) :-
:- non_counted_backtracking '$iterate_find_all_diff'/5.
'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :-
'$call_with_inference_counting'('$call'(Goal)),
'$call_with_inference_counting'(call(Goal)),
'$copy_to_lh'(LhOffset, Template),
'$fail'.
'$iterate_find_all_diff'(_, _, Solutions0, Solutions1, LhOffset) :-
@@ -897,33 +903,7 @@ module_asserta_clause(Head, Body, Module) :-
; throw(error(type_error(callable, Head), asserta/1))
).
asserta_clause(Head, Body) :-
( var(Head) ->
throw(error(instantiation_error, asserta/1))
; callable(Head), functor(Head, Name, Arity) ->
( Name == (:),
Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, HeadAndBody),
( HeadAndBody = (F :- Body1) ->
true
; F = HeadAndBody,
Body1 = true
),
module_asserta_clause(F, Body1, Module)
; '$head_is_dynamic'(user, Head) ->
call_asserta(Head, Body, Name, Arity, user)
; '$no_such_predicate'(user, Head) ->
call_asserta(Head, Body, Name, Arity, user)
; throw(error(permission_error(modify, static_procedure, Name/Arity),
asserta/1))
)
; throw(error(type_error(callable, Head), asserta/1))
).
:- meta_predicate asserta(0).
:- meta_predicate asserta(:).
asserta(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
@@ -959,33 +939,7 @@ call_assertz(Head, Body, Name, Arity, Module) :-
functor(_, Name, Arity),
'$assertz'(Head, Body, Name, Arity, Module).
assertz_clause(Head, Body) :-
( var(Head) ->
throw(error(instantiation_error, assertz/1))
; callable(Head), functor(Head, Name, Arity) ->
( Name == (:),
Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, HeadAndBody),
( HeadAndBody = (F :- Body1) ->
true
; F = HeadAndBody,
Body1 = true
),
module_assertz_clause(F, Body1, Module)
; '$head_is_dynamic'(user, Head) ->
call_assertz(Head, Body, Name, Arity, user)
; '$no_such_predicate'(user, Head) ->
call_assertz(Head, Body, Name, Arity, user)
; throw(error(permission_error(modify, static_procedure, Name/Arity),
assertz/1))
)
; throw(error(type_error(callable, Head), assertz/1))
).
:- meta_predicate assertz(0).
:- meta_predicate assertz(:).
assertz(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
@@ -1086,7 +1040,7 @@ retract_clause(Head, Body) :-
).
:- meta_predicate retract(0).
:- meta_predicate retract(:).
retract(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
@@ -1102,7 +1056,7 @@ retract(Clause0) :-
).
:- meta_predicate retractall(0).
:- meta_predicate retractall(:).
retractall(Head) :-
retract_clause(Head, _),
@@ -1139,7 +1093,7 @@ module_abolish(Pred, Module) :-
).
:- meta_predicate abolish(0).
:- meta_predicate abolish(:).
abolish(Pred) :-
( var(Pred) ->

View File

@@ -1122,6 +1122,8 @@ indomain(1).
% CountAnd = 1.
% ==
sat_count(Sat0, N) :-
catch((parse_sat(Sat0, Sat),
sat_bdd(Sat, BDD),

View File

@@ -7611,7 +7611,7 @@ verify_attributes(Var, Other, Gs) :-
),
domain_contains(Dom, Other),
phrase(trigger_props(Ps), [Q], [_]),
Gs = [phrase(do_queue, [Q], _)]
Gs = [phrase(clpz:do_queue, [Q], _)]
; ( get_atts(Other, clpz(clpz_attr(_,_,_,OD,OPs,_))) ->
domains_intersection(OD, Dom, Dom1),
append_propagators(Ps, OPs, Ps1),
@@ -7619,7 +7619,7 @@ verify_attributes(Var, Other, Gs) :-
variables_same_queue([Var,Other]),
phrase((fd_put(Other,Dom1,Ps1),
trigger_props(Ps1)), [Q0], _),
Gs = [phrase(do_queue, [Q0], _)]
Gs = [phrase(clpz:do_queue, [Q0], _)]
; put_atts(Other, clpz(CLPZ)),
Gs = []
)

View File

@@ -18,7 +18,7 @@ load_context(GRBody, Module, GRBody0) :-
true
; prolog_load_context(module, Module) ->
true
; true
; Module = user
).
@@ -34,7 +34,7 @@ phrase(GRBody, S0, S) :-
( var(GRBody0) ->
instantiation_error(phrase/3)
; dcg_body(GRBody0, S0, S, GRBody1, Module) ->
call(GRBody1)
call(Module:GRBody1)
; type_error(callable, GRBody0, phrase/3)
).

View File

@@ -10,6 +10,10 @@
type_error/3
]).
:- meta_predicate check_(1, ?, ?).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
must_be(Type, Term)

View File

@@ -3,7 +3,7 @@
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- meta_predicate freeze(?, 0).
:- meta_predicate freeze(?, :).
:- attribute frozen/1.

View File

@@ -1,8 +1,3 @@
%% for builtins that are not part of the ISO standard.
%% must be loaded at the REPL with
%% ?- use_module(library(iso_ext)).
:- module(iso_ext, [bb_b_put/2,
bb_get/2,
bb_put/2,
@@ -14,7 +9,6 @@
partial_string_tail/2,
setup_call_cleanup/3,
call_nth/2,
% variant/2,
copy_term_nat/2]).
:- use_module(library(error), [can_be/2,
@@ -64,7 +58,7 @@ call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
'$call_with_inference_counting'('$call'(S)),
'$call_with_inference_counting'(call(S)),
'$set_cp_by_default'(B),
'$get_current_block'(Bb),
( C = _:CC,
@@ -80,7 +74,7 @@ setup_call_cleanup(S, G, C) :-
scc_helper(C, G, Bb) :-
'$get_cp'(Cp),
'$install_scc_cleaner'(C, NBb),
'$call_with_inference_counting'('$call'(G)),
'$call_with_inference_counting'(call(G)),
( '$check_cp'(Cp) ->
'$reset_block'(Bb),
run_cleaners_without_handling(Cp)
@@ -115,7 +109,7 @@ run_cleaners_with_handling :-
run_cleaners_without_handling(Cp) :-
'$get_scc_cleaner'(C),
'$get_level'(B),
'$call'(C),
call(C),
'$set_cp_by_default'(B),
run_cleaners_without_handling(Cp).
run_cleaners_without_handling(Cp) :-
@@ -170,7 +164,7 @@ install_inference_counter(B, L, Count0) :-
call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0),
'$call_with_inference_counting'('$call'(G)),
'$call_with_inference_counting'(call(G)),
'$inference_level'(R, B),
'$remove_inference_counter'(B, Count1),
is(Diff, L - (Count1 - Count0)),

View File

@@ -5,7 +5,7 @@
map_list_to_pairs/3]).
:- meta_predicate map_list_to_pairs(0, ?, ?).
:- meta_predicate map_list_to_pairs(2, ?, ?).
pairs_keys_values([], [], []).
pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-

View File

@@ -1,6 +1,6 @@
:- module(reif, [if_/3, (=)/3, (',')/3, (;)/3, cond_t/3, dif/3,
memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
tpartition/4]).
memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
tpartition/4]).
:- use_module(library(dif)).
@@ -30,13 +30,10 @@ non(false, true).
:- meta_predicate(tfilter(2, ?, ?)).
tfilter(C_2, Es, Fs) :-
i_tfilter(Es, C_2, Fs).
i_tfilter([], _, []).
i_tfilter([E|Es], C_2, Fs0) :-
tfilter(_, [], []).
tfilter(C_2, [E|Es], Fs0) :-
if_(call(C_2, E), Fs0 = [E|Fs], Fs0 = Fs),
i_tfilter(Es, C_2, Fs).
tfilter(C_2, Es, Fs).
:- meta_predicate(tpartition(2, ?, ?, ?)).

View File

@@ -67,7 +67,7 @@ table_and_status_for_variant(V,T,S) :-
tbd_table_status(T,S).
:- meta_predicate start_tabling(?, 0).
:- meta_predicate start_tabling(?, :).
start_tabling(Wrapper,Worker) :-
put_new_trie_table_link,

View File

@@ -4,8 +4,8 @@
numbervars(Term, N0, N) :-
catch(internal_numbervars(Term, N0, N),
error(E,Ctx),
( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
error(E,Ctx),
( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
internal_numbervars(Term, N0, N) :-
must_be(integer, N0),