diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/chr/chr_translate_bootstrap1.chr

2316 lines
62 KiB
Plaintext
Raw Blame History

/* Generated by CHR bootstrap compiler
From: chr_translate_bootstrap1.pl
Date: Fri Jan 12 13:49:11 2007
DO NOT EDIT. EDIT THE CHR FILE INSTEAD
*/
:- module(chr_translate_bootstrap1,
[ chr_translate/2
]).
:- use_module(chr_runtime).
:- style_check(- (discontiguous)).
:- use_module(chr_runtime).
:- style_check(- (discontiguous)).
:- use_module(library(lists),
[ append/3,
member/2,
permutation/2,
reverse/2
]).
:- use_module(library(ordsets)).
:- use_module(library(dialect/hprolog)).
:- use_module(pairlist).
:- include(chr_op2).
chr_translate(A, C) :-
init_chr_pp_flags,
partition_clauses(A, B, E, D),
( B==[]
-> C=D
; check_rules(E, B),
unique_analyse_optimise(E, F),
check_attachments(F),
set_constraint_indices(B, 1),
store_management_preds(B, G),
constraints_code(B, F, H),
append([D, G, H], C)
),
chr_clear.
store_management_preds(A, E) :-
generate_attach_detach_a_constraint_all(A, B),
generate_attach_increment(C),
generate_attr_unify_hook(D),
append([B, C, D], E).
partition_clauses([], [], [], []).
partition_clauses([A|M], B, C, E) :-
( rule(A, D)
-> B=G,
C=[D|H],
E=I
; is_declaration(A, F)
-> append(F, G, B),
C=H,
E=I
; is_module_declaration(A, J)
-> target_module(J),
B=G,
C=H,
E=[A|I]
; A=handler(_)
-> format('CHR compiler WARNING: ~w.\n', [A]),
format(' `--> SICStus compatibility: ignoring handler/1 declaration.\n', []),
B=G,
C=H,
E=I
; A=rules(_)
-> format('CHR compiler WARNING: ~w.\n', [A]),
format(' `--> SICStus compatibility: ignoring rules/1 declaration.\n', []),
B=G,
C=H,
E=I
; A= (:-chr_option(K, L))
-> handle_option(K, L),
B=G,
C=H,
E=I
; B=G,
C=H,
E=[A|I]
),
partition_clauses(M, G, H, I).
is_declaration(A, D) :-
A= (:-B),
( B=..[chr_constraint, C]
; B=..[chr_constraint, C]
),
conj2list(C, D).
rule(A, D) :-
A= @(C, B), !,
rule(B, yes(C), D).
rule(A, B) :-
rule(A, no, B).
rule(A, H, D) :-
A=pragma(B, C), !,
is_rule(B, E, F),
conj2list(C, G),
D=pragma(E, F, G, H).
rule(A, E, B) :-
is_rule(A, C, D),
B=pragma(C, D, [], E).
is_rule(A, G, D) :-
A= ==>(B, F), !,
conj2list(B, C),
get_ids(C, E, H),
D=ids([], E),
( F= '|'(I,J)
-> G=rule([], H, I, J)
; G=rule([], H, true, F)
).
is_rule(A, R, M) :-
A= <=>(G, B), !,
( B= '|'(C,D)
-> E=C,
F=D
; E=true,
F=B
),
( G= \(H, I)
-> conj2list(H, J),
conj2list(I, K),
get_ids(J, O, P, 0, L),
get_ids(K, N, Q, L, _),
M=ids(N, O)
; conj2list(G, K),
P=[],
get_ids(K, N, Q),
M=ids(N, [])
),
R=rule(Q, P, E, F).
get_ids(A, B, C) :-
get_ids(A, B, C, 0, _).
get_ids([], [], [], A, A).
get_ids([B|D], [A|E], [C|F], A, H) :-
( B= #(C, A)
-> true
; C=B
),
G is A+1,
get_ids(D, E, F, G, H).
is_module_declaration((:-module(A)), A).
is_module_declaration((:-module(A, _)), A).
check_rules(A, B) :-
check_rules(A, B, 1).
check_rules([], _, _).
check_rules([A|D], B, C) :-
check_rule(A, B, C),
E is C+1,
check_rules(D, B, E).
check_rule(A, F, G) :-
A=pragma(B, _, H, _),
B=rule(C, D, _, _),
append(C, D, E),
check_head_constraints(E, F, A, G),
check_pragmas(H, A, G).
check_head_constraints([], _, _, _).
check_head_constraints([A|E], D, F, G) :-
functor(A, B, C),
( member(B/C, D)
-> check_head_constraints(E, D, F, G)
; format('CHR compiler ERROR: Undeclared constraint ~w in head of ~@.\n', [B/C, format_rule(F, G)]),
format(' `--> Constraint should be on of ~w.\n', [D]),
fail
).
check_pragmas([], _, _).
check_pragmas([A|D], B, C) :-
check_pragma(A, B, C),
check_pragmas(D, B, C).
check_pragma(A, B, C) :-
var(A), !,
format('CHR compiler ERROR: invalid pragma ~w in ~@.\n', [A, format_rule(B, C)]),
format(' `--> Pragma should not be a variable!\n', []),
fail.
check_pragma(passive(B), A, E) :- !,
A=pragma(_, ids(C, D), _, _),
( memberchk_eq(B, C)
-> true
; memberchk_eq(B, D)
-> true
; format('CHR compiler ERROR: invalid identifier ~w in pragma passive in ~@.\n', [B, format_rule(A, E)]),
fail
).
check_pragma(A, B, C) :-
A=unique(_, _), !,
format('CHR compiler WARNING: undocumented pragma ~w in ~@.\n', [A, format_rule(B, C)]),
format(' `--> Only use this pragma if you know what you are doing.\n', []).
check_pragma(A, B, C) :-
A=already_in_heads, !,
format('CHR compiler WARNING: currently unsupported pragma ~w in ~@.\n', [A, format_rule(B, C)]),
format(' `--> Pragma is ignored. Termination and correctness may be affected \n', []).
check_pragma(A, B, C) :-
A=already_in_head(_), !,
format('CHR compiler WARNING: currently unsupported pragma ~w in ~@.\n', [A, format_rule(B, C)]),
format(' `--> Pragma is ignored. Termination and correctness may be affected \n', []).
check_pragma(A, B, C) :-
format('CHR compiler ERROR: invalid pragma ~w in ~@.\n', [A, format_rule(B, C)]),
format(' `--> Pragma should be one of passive/1!\n', []),
fail.
format_rule(A, D) :-
A=pragma(_, _, _, B),
( B=yes(C)
-> write('rule '),
write(C)
; write('rule number '),
write(D)
).
handle_option(A, B) :-
var(A), !,
format('CHR compiler ERROR: ~w.\n', [option(A, B)]),
format(' `--> First argument should be an atom, not a variable.\n', []),
fail.
handle_option(B, A) :-
var(A), !,
format('CHR compiler ERROR: ~w.\n', [option(B, A)]),
format(' `--> Second argument should be a nonvariable.\n', []),
fail.
handle_option(A, B) :-
option_definition(A, B, C), !,
set_chr_pp_flags(C).
handle_option(A, _) :-
\+option_definition(A, _, _), !.
handle_option(A, C) :-
findall(B, option_definition(A, B, _), D),
format('CHR compiler ERROR: ~w.\n', [option(A, C)]),
format(' `--> Invalid value ~w: should be one of ~w.\n', [C, D]),
fail.
option_definition(optimize, experimental, A) :-
A=[unique_analyse_optimise-on, check_unnecessary_active-full, reorder_heads-on, set_semantics_rule-on, check_attachments-on, guard_via_reschedule-on].
option_definition(optimize, full, A) :-
A=[unique_analyse_optimise-on, check_unnecessary_active-full, reorder_heads-on, set_semantics_rule-on, check_attachments-on, guard_via_reschedule-on].
option_definition(optimize, sicstus, A) :-
A=[unique_analyse_optimise-off, check_unnecessary_active-simplification, reorder_heads-off, set_semantics_rule-off, check_attachments-off, guard_via_reschedule-off].
option_definition(optimize, off, A) :-
A=[unique_analyse_optimise-off, check_unnecessary_active-off, reorder_heads-off, set_semantics_rule-off, check_attachments-off, guard_via_reschedule-off].
option_definition(debug, off, A) :-
A=[debugable-off].
option_definition(debug, on, A) :-
A=[debugable-on].
option_definition(check_guard_bindings, on, A) :-
A=[guard_locks-on].
option_definition(check_guard_bindings, off, A) :-
A=[guard_locks-off].
init_chr_pp_flags :-
chr_pp_flag_definition(A, [B|_]),
set_chr_pp_flag(A, B),
fail.
init_chr_pp_flags.
set_chr_pp_flags([]).
set_chr_pp_flags([A-B|C]) :-
set_chr_pp_flag(A, B),
set_chr_pp_flags(C).
set_chr_pp_flag(A, C) :-
atomic_concat('$chr_pp_', A, B),
nb_setval(B, C).
chr_pp_flag_definition(unique_analyse_optimise, [on, off]).
chr_pp_flag_definition(check_unnecessary_active, [full, simplification, off]).
chr_pp_flag_definition(reorder_heads, [on, off]).
chr_pp_flag_definition(set_semantics_rule, [on, off]).
chr_pp_flag_definition(guard_via_reschedule, [on, off]).
chr_pp_flag_definition(guard_locks, [on, off]).
chr_pp_flag_definition(check_attachments, [on, off]).
chr_pp_flag_definition(debugable, [off, on]).
chr_pp_flag(A, D) :-
atomic_concat('$chr_pp_', A, B),
nb_getval(B, C),
( C==[]
-> chr_pp_flag_definition(A, [D|_])
; C=D
).
generate_attach_detach_a_constraint_all([], []).
generate_attach_detach_a_constraint_all([A|D], F) :-
( is_attached(A)
-> generate_attach_a_constraint(A, B),
generate_detach_a_constraint(A, C)
; B=[],
C=[]
),
generate_attach_detach_a_constraint_all(D, E),
append([B, C, E], F).
generate_attach_a_constraint(A, [B, D]) :-
generate_attach_a_constraint_empty_list(A, B),
get_max_constraint_index(C),
( C==1
-> generate_attach_a_constraint_1_1(A, D)
; generate_attach_a_constraint_t_p(A, D)
).
generate_attach_a_constraint_empty_list(A/B, E) :-
atom_concat_list([attach_, A, /, B], C),
D=[[], _],
F=..[C|D],
E= (F:-true).
generate_attach_a_constraint_1_1(A/B, L) :-
atom_concat_list([attach_, A, /, B], C),
D=[[G|E], F],
M=..[C|D],
K=..[C, E, F],
get_target_module(H),
N= ((get_attr(G, H, I)->J=[F|I], put_attr(G, H, J);put_attr(G, H, [F])), K),
L= (M:-N).
generate_attach_a_constraint_t_p(A/B, Z) :-
atom_concat_list([attach_, A, /, B], C),
D=[[Q|E], F],
A1=..[C|D],
Y=..[C, E, F],
get_constraint_index(A/B, G),
or_pattern(G, P),
get_max_constraint_index(H),
make_attr(H, K, I, T),
nth1(G, I, J),
substitute_eq(J, I, [F|J], L),
make_attr(H, K, L, U),
substitute_eq(J, I, [F], M),
make_attr(H, V, M, W),
copy_term_nat(I, N),
nth1(G, N, [F]),
chr_delete(N, [F], O),
set_elems(O, []),
make_attr(H, P, N, X),
get_target_module(R),
B1= ((get_attr(Q, R, S)->S=T, (K/\P=:=P->put_attr(Q, R, U);V is K\/P, put_attr(Q, R, W));put_attr(Q, R, X)), Y),
Z= (A1:-B1).
generate_detach_a_constraint(A, [B, D]) :-
generate_detach_a_constraint_empty_list(A, B),
get_max_constraint_index(C),
( C==1
-> generate_detach_a_constraint_1_1(A, D)
; generate_detach_a_constraint_t_p(A, D)
).
generate_detach_a_constraint_empty_list(A/B, E) :-
atom_concat_list([detach_, A, /, B], C),
D=[[], _],
F=..[C|D],
E= (F:-true).
generate_detach_a_constraint_1_1(A/B, L) :-
atom_concat_list([detach_, A, /, B], C),
D=[[G|E], F],
M=..[C|D],
K=..[C, E, F],
get_target_module(H),
N= ((get_attr(G, H, I)->'chr sbag_del_element'(I, F, J), (J==[]->del_attr(G, H);put_attr(G, H, J));true), K),
L= (M:-N).
generate_detach_a_constraint_t_p(A/B, Y) :-
atom_concat_list([detach_, A, /, B], C),
D=[[N|E], F],
Z=..[C|D],
X=..[C, E, F],
get_constraint_index(A/B, G),
or_pattern(G, R),
and_pattern(G, U),
get_max_constraint_index(H),
make_attr(H, L, I, Q),
nth1(G, I, J),
substitute_eq(J, I, [], K),
make_attr(H, T, K, V),
substitute_eq(J, I, S, M),
make_attr(H, L, M, W),
get_target_module(O),
A1= ((get_attr(N, O, P)->P=Q, (L/\R=:=R->'chr sbag_del_element'(J, F, S), (S==[]->T is L/\U, (T==0->del_attr(N, O);put_attr(N, O, V));put_attr(N, O, W));true);true), X),
Y= (Z:-A1).
generate_attach_increment([A, C]) :-
generate_attach_increment_empty(A),
get_max_constraint_index(B),
( B==1
-> generate_attach_increment_one(C)
; generate_attach_increment_many(B, C)
).
generate_attach_increment_empty((attach_increment([], _):-true)).
generate_attach_increment_one(H) :-
I=attach_increment([A|G], D),
get_target_module(B),
J= ('chr not_locked'(A), (get_attr(A, B, C)->sort(C, E), merge(D, E, F), put_attr(A, B, F);put_attr(A, B, D)), attach_increment(G, D)),
H= (I:-J).
generate_attach_increment_many(A, Z) :-
make_attr(A, V, C, B),
make_attr(A, W, D, S),
A1=attach_increment([P|Y], B),
bagof(G, E^F^H^I^ (member2(C, D, E-F), G= (sort(F, H), 'chr merge_attributes'(E, H, I))), J),
list2conj(J, T),
bagof(N, K^L^M^member((K, 'chr merge_attributes'(L, M, N)), J), O),
make_attr(A, U, O, X),
get_target_module(Q),
B1= ('chr not_locked'(P), (get_attr(P, Q, R)->R=S, T, U is V\/W, put_attr(P, Q, X);put_attr(P, Q, B)), attach_increment(Y, B)),
Z= (A1:-B1).
generate_attr_unify_hook([B]) :-
get_max_constraint_index(A),
( A==1
-> generate_attr_unify_hook_one(B)
; generate_attr_unify_hook_many(A, B)
).
generate_attr_unify_hook_one(K) :-
L=A:attr_unify_hook(B, C),
get_target_module(A),
make_run_suspensions(G, H),
make_run_suspensions(B, J),
M= (sort(B, E), (var(C)-> (get_attr(C, A, D)->true;D=[]), sort(D, F), 'chr merge_attributes'(E, F, G), put_attr(C, A, G), H; (compound(C)->term_variables(C, I), attach_increment(I, E);true), J)),
K= (L:-M).
generate_attr_unify_hook_many(A, F1) :-
make_attr(A, Q, C, R),
make_attr(A, Z, H, W),
bagof(D, B^E^ (member(B, C), D=sort(B, E)), F),
list2conj(F, T),
bagof(E, B^member(sort(B, E), F), G),
bagof(K, I^J^L^M^ (member2(G, H, I-J), K= (sort(J, L), 'chr merge_attributes'(I, L, M))), O),
bagof(M, I^L^N^member((N, 'chr merge_attributes'(I, L, M)), O), P),
list2conj(O, X),
make_attr(A, Y, P, A1),
make_attr(A, Q, G, C1),
G1=S:attr_unify_hook(R, U),
get_target_module(S),
make_run_suspensions_loop(P, B1),
make_run_suspensions_loop(G, D1),
H1= (T, (var(U)-> (get_attr(U, S, V)->V=W, X, Y is Q\/Z, put_attr(U, S, A1), B1;put_attr(U, S, C1), D1); (compound(U)->term_variables(U, E1), attach_increment(E1, C1);true), D1)),
F1= (G1:-H1).
make_run_suspensions(B, A) :-
( chr_pp_flag(debugable, on)
-> A='chr run_suspensions_d'(B)
; A='chr run_suspensions'(B)
).
make_run_suspensions_loop(B, A) :-
( chr_pp_flag(debugable, on)
-> A='chr run_suspensions_loop_d'(B)
; A='chr run_suspensions_loop'(B)
).
check_attachments(A) :-
( chr_pp_flag(check_attachments, on)
-> check_attachments_(A)
; true
).
check_attachments_([]).
check_attachments_([A|B]) :-
check_attachment(A),
check_attachments_(B).
check_attachment(A) :-
A=pragma(B, _, _, _),
B=rule(C, D, E, F),
check_attachment_heads1(C, C, D, E),
check_attachment_heads2(D, C, F).
check_attachment_heads1([], _, _, _).
check_attachment_heads1([A|H], B, C, D) :-
functor(A, F, G),
( B==[A],
C==[],
D==true,
A=..[_|E],
no_matching(E, [])
-> attached(F/G, no)
; attached(F/G, maybe)
),
check_attachment_heads1(H, B, C, D).
no_matching([], _).
no_matching([A|C], B) :-
var(A),
\+memberchk_eq(A, B),
no_matching(C, [A|B]).
check_attachment_heads2([], _, _).
check_attachment_heads2([A|F], B, C) :-
functor(A, D, E),
( B\==[],
C==true
-> attached(D/E, maybe)
; attached(D/E, yes)
),
check_attachment_heads2(F, B, C).
all_attached([]).
all_attached([A|D]) :-
functor(A, B, C),
is_attached(B/C),
all_attached(D).
set_constraint_indices([], A) :-
B is A-1,
max_constraint_index(B).
set_constraint_indices([A|C], B) :-
( is_attached(A)
-> constraint_index(A, B),
D is B+1,
set_constraint_indices(C, D)
; set_constraint_indices(C, B)
).
constraints_code(A, B, D) :-
post_constraints(A, 1),
constraints_code1(1, B, C, []),
clean_clauses(C, D).
post_constraints([], A) :-
B is A-1,
constraint_count(B).
post_constraints([A/B|D], C) :-
constraint(A/B, C),
E is C+1,
post_constraints(D, E).
constraints_code1(A, E, D, C) :-
constraint_count(B),
( A>B
-> C=D
; constraint_code(A, E, D, G),
F is A+1,
constraints_code1(F, E, G, C)
).
constraint_code(A, E, C, J) :-
constraint(B, A),
constraint_prelude(B, D),
C=[D|G],
F=[0],
rules_code(E, 1, A, F, H, G, I),
gen_cond_attach_clause(B, H, I, J).
constraint_prelude(B/A, E) :-
vars_susp(A, C, I, D),
F=..[B|C],
build_head(B, A, [0], D, H),
get_target_module(G),
( chr_pp_flag(debugable, on)
-> E= (F:-'chr allocate_constraint'(G:H, I, B, C), ('chr debug_event'(call(I)), H;'chr debug_event'(fail(I)), !, fail), ('chr debug_event'(exit(I));'chr debug_event'(redo(I)), fail))
; E= (F:-H)
).
gen_cond_attach_clause(A/B, C, K, M) :-
( is_attached(A/B)
-> ( C==[0]
-> gen_cond_attach_goal(A/B, G, F, D, E)
; vars_susp(B, D, E, F),
gen_uncond_attach_goal(A/B, E, G, _)
),
( chr_pp_flag(debugable, on)
-> H=..[A|D],
I='chr debug_event'(insert(#(H, E)))
; I=true
),
build_head(A, B, C, F, J),
L= (J:-I, G),
K=[L|M]
; K=M
).
gen_cond_attach_goal(E/A, G, D, B, C) :-
vars_susp(A, B, C, D),
build_head(E, A, [0], D, J),
atom_concat_list([attach_, E, /, A], F),
K=..[F, H, C],
get_target_module(I),
G= ((var(C)->'chr insert_constraint_internal'(H, C, I:J, E, B);'chr activate_constraint'(H, C, _)), K).
gen_uncond_attach_goal(A/B, D, E, G) :-
atom_concat_list([attach_, A, /, B], C),
H=..[C, F, D],
E= ('chr activate_constraint'(F, D, G), H).
rules_code([], _, _, A, A, B, B).
rules_code([A|F], B, C, D, I, E, K) :-
rule_code(A, B, C, D, H, E, J),
G is B+1,
rules_code(F, G, C, H, I, J, K).
rule_code(A, K, F, G, L, H, N) :-
A=pragma(C, B, _, _),
B=ids(E, J),
C=rule(D, I, _, _),
heads1_code(D, [], E, [], A, F, G, H, M),
heads2_code(I, [], J, [], A, K, F, G, L, M, N).
heads1_code([], _, _, _, _, _, _, A, A).
heads1_code([C|J], F, [H|L], M, A, B, P, Q, S) :-
A=pragma(G, _, I, _),
constraint(D/E, B),
( functor(C, D, E),
\+check_unnecessary_active(C, F, G),
\+memberchk_eq(passive(H), I),
all_attached(J),
all_attached(F),
G=rule(_, K, _, _),
all_attached(K)
-> append(J, F, N),
append(L, M, O),
head1_code(C, N, O, A, D/E, B, P, Q, R)
; Q=R
),
heads1_code(J, [C|F], L, [H|M], A, B, P, R, S).
head1_code(D, E, F, A, I, _, J, K, L) :-
A=pragma(B, _, _, _),
B=rule(_, C, _, _),
( C==[]
-> reorder_heads(D, E, F, G, H),
simplification_code(D, G, H, A, I, J, K, L)
; simpagation_head1_code(D, E, F, A, I, J, K, L)
).
heads2_code([], _, _, _, _, _, _, A, A, B, B).
heads2_code([C|J], F, [H|L], M, A, P, B, R, W, S, X) :-
A=pragma(G, _, I, _),
constraint(D/E, B),
( functor(C, D, E),
\+check_unnecessary_active(C, F, G),
\+memberchk_eq(passive(H), I),
\+set_semantics_rule(A),
all_attached(J),
all_attached(F),
G=rule(K, _, _, _),
all_attached(K)
-> append(J, F, N),
append(L, M, O),
length(J, Q),
head2_code(C, N, O, A, P, Q, D/E, R, S, T),
inc_id(R, V),
gen_alloc_inc_clause(D/E, R, T, U)
; S=U,
V=R
),
heads2_code(J, [C|F], L, [H|M], A, P, B, V, W, U, X).
head2_code(D, E, M, A, G, H, I, J, K, L) :-
A=pragma(B, _, _, _),
B=rule(C, _, _, _),
( C==[]
-> reorder_heads(D, E, F),
propagation_code(D, F, B, G, H, I, J, K, L)
; simpagation_head2_code(D, E, M, A, I, J, K, L)
).
gen_alloc_inc_clause(B/A, C, K, M) :-
vars_susp(A, F, G, D),
build_head(B, A, C, D, I),
inc_id(C, E),
build_head(B, A, E, D, J),
( C==[0]
-> gen_cond_allocation(F, G, B/A, D, H)
; H=true
),
L= (I:-H, J),
K=[L|M].
gen_cond_allocation(H, E, A/B, C, D) :-
build_head(A, B, [0], C, G),
get_target_module(F),
D= (var(E)->'chr allocate_constraint'(F:G, E, A, H);true).
guard_via_reschedule(A, B, C, D) :-
( chr_pp_flag(guard_via_reschedule, on)
-> guard_via_reschedule_main(A, B, C, D)
; append(A, B, E),
list2conj(E, D)
).
guard_via_reschedule_main(B, C, A, G) :-
initialize_unit_dictionary(A, D),
build_units(B, C, D, E),
dependency_reorder(E, F),
units2goal(F, G).
units2goal([], true).
units2goal([unit(_, A, _, _)|B], (A, C)) :-
units2goal(B, C).
dependency_reorder(A, B) :-
dependency_reorder(A, [], B).
dependency_reorder([], A, B) :-
reverse(A, B).
dependency_reorder([A|F], C, G) :-
A=unit(_, _, B, D),
( B==fixed
-> E=[A|C]
; dependency_insert(C, A, D, E)
),
dependency_reorder(F, E, G).
dependency_insert([], A, _, [A]).
dependency_insert([A|F], E, C, D) :-
A=unit(B, _, _, _),
( memberchk(B, C)
-> D=[E, A|F]
; D=[A|G],
dependency_insert(F, E, C, G)
).
build_units(A, D, B, C) :-
build_retrieval_units(A, 1, E, B, F, C, G),
build_guard_units(D, E, F, G).
build_retrieval_units([], A, A, B, B, C, C).
build_retrieval_units([A|G], C, I, D, K, E, M) :-
term_variables(A, B),
update_unit_dictionary(B, C, D, J, [], F),
E=[unit(C, A, movable, F)|L],
H is C+1,
build_retrieval_units2(G, H, I, J, K, L, M).
build_retrieval_units2([], A, A, B, B, C, C).
build_retrieval_units2([A|G], C, I, D, K, E, M) :-
term_variables(A, B),
update_unit_dictionary(B, C, D, J, [], F),
E=[unit(C, A, fixed, F)|L],
H is C+1,
build_retrieval_units(G, H, I, J, K, L, M).
initialize_unit_dictionary(A, C) :-
term_variables(A, B),
pair_all_with(B, 0, C).
update_unit_dictionary([], _, A, A, B, B).
update_unit_dictionary([B|H], D, A, I, E, J) :-
( lookup_eq(A, B, C)
-> ( ( C==D
; memberchk(C, E)
)
-> F=E
; F=[C|E]
),
G=A
; G=[B-D|A],
F=E
),
update_unit_dictionary(H, D, G, I, F, J).
build_guard_units(A, C, F, B) :-
( A=[D]
-> B=[unit(C, D, fixed, [])]
; A=[D|H]
-> term_variables(D, E),
update_unit_dictionary2(E, C, F, J, [], G),
B=[unit(C, D, movable, G)|K],
I is C+1,
build_guard_units(H, I, J, K)
).
update_unit_dictionary2([], _, A, A, B, B).
update_unit_dictionary2([B|H], D, A, I, E, J) :-
( lookup_eq(A, B, C)
-> ( ( C==D
; memberchk(C, E)
)
-> F=E
; F=[C|E]
),
G=[B-D|A]
; G=[B-D|A],
F=E
),
update_unit_dictionary2(H, D, G, I, F, J).
unique_analyse_optimise(A, B) :-
( chr_pp_flag(unique_analyse_optimise, on)
-> unique_analyse_optimise_main(A, 1, [], B)
; B=A
).
unique_analyse_optimise_main([], _, _, []).
unique_analyse_optimise_main([A|R], B, D, [O|T]) :-
( discover_unique_pattern(A, B, C)
-> E=[C|D]
; E=D
),
A=pragma(F, G, N, Q),
F=rule(H, J, _, _),
G=ids(I, K),
apply_unique_patterns_to_constraints(H, I, E, L),
apply_unique_patterns_to_constraints(J, K, E, M),
append([L, M, N], P),
O=pragma(F, G, P, Q),
S is B+1,
unique_analyse_optimise_main(R, S, E, T).
apply_unique_patterns_to_constraints([], _, _, []).
apply_unique_patterns_to_constraints([B|H], [C|I], A, E) :-
( member(D, A),
apply_unique_pattern(B, C, D, F)
-> E=[F|G]
; E=G
),
apply_unique_patterns_to_constraints(H, I, A, G).
apply_unique_pattern(B, L, A, K) :-
A=unique(C, E),
subsumes(B, C, F),
( setof(I, D^G^H^ (member(D, E), lookup_eq(F, D, G), term_variables(G, H), member(I, H)), J)
-> true
; J=[]
),
K=unique(L, J).
subsumes(A, B, F) :-
empty_ds(C),
subsumes_aux(A, B, C, D),
ds_to_list(D, E),
build_unifier(E, F).
subsumes_aux(B, A, E, F) :-
( compound(A),
functor(A, C, D)
-> compound(B),
functor(B, C, D),
subsumes_aux(D, B, A, E, F)
; B==A
-> F=E
; var(A),
get_ds(B, E, G)
-> G==A,
F=E
; var(A),
put_ds(B, E, A, F)
).
subsumes_aux(0, _, _, A, A) :- !.
subsumes_aux(A, B, C, F, I) :-
arg(A, B, D),
arg(A, C, E),
subsumes_aux(D, E, F, H),
G is A-1,
subsumes_aux(G, B, C, H, I).
build_unifier([], []).
build_unifier([B-A|C], [A-B|D]) :-
build_unifier(C, D).
discover_unique_pattern(A, M, L) :-
A=pragma(B, _, G, N),
( B=rule([C], [D], E, F)
-> true
; B=rule([C, D], [], E, F)
),
check_unique_constraints(C, D, E, F, G, H),
term_variables(C, I),
select_pragma_unique_variables(H, I, J),
K=unique(C, J),
copy_term_nat(K, L),
( verbosity_on
-> format('Found unique pattern ~w in rule ~d~@\n', [L, M, (N=yes(O)->write([58, 32]), write(O);true)])
; true
).
select_pragma_unique_variables([], _, []).
select_pragma_unique_variables([A-B|F], D, C) :-
( A==B
-> C=[A|E]
; once((
( \+memberchk_eq(A, D)
; \+memberchk_eq(B, D)
)
)),
C=E
),
select_pragma_unique_variables(F, D, E).
check_unique_constraints(B, C, E, _, A, D) :-
\+member(passive(_), A),
variable_replacement(B-C, C-B, D),
copy_with_variable_replacement(E, G, D),
negate(E, F),
once(entails(F, G)).
negate(true, fail).
negate(fail, true).
negate(B=<A, A<B).
negate(B>A, A>=B).
negate(B>=A, A>B).
negate(B<A, A=<B).
negate(var(A), nonvar(A)).
negate(nonvar(A), var(A)).
entails(B, A) :-
A==B.
entails(fail, _).
entails(B>D, A>=C) :-
A==B,
C==D.
entails(B<D, A=<C) :-
A==B,
C==D.
entails(ground(B), nonvar(A)) :-
A==B.
entails(compound(B), nonvar(A)) :-
A==B.
entails(atomic(B), nonvar(A)) :-
A==B.
entails(number(B), nonvar(A)) :-
A==B.
entails(atom(B), nonvar(A)) :-
A==B.
check_unnecessary_active(A, B, C) :-
( chr_pp_flag(check_unnecessary_active, full)
-> check_unnecessary_active_main(A, B, C)
; chr_pp_flag(check_unnecessary_active, simplification),
C=rule(_, [], _, _)
-> check_unnecessary_active_main(A, B, C)
; fail
).
check_unnecessary_active_main(C, A, D) :-
member(B, A),
variable_replacement(B, C, E),
copy_with_variable_replacement(D, F, E),
identical_rules(D, F), !.
set_semantics_rule(A) :-
( chr_pp_flag(set_semantics_rule, on)
-> set_semantics_rule_main(A)
; fail
).
set_semantics_rule_main(A) :-
A=pragma(B, C, E, _),
B=rule([_], [_], true, _),
C=ids([D], [F]),
once(member(unique(D, G), E)),
once(member(unique(F, H), E)),
G==H,
\+memberchk_eq(passive(D), E).
identical_rules(rule(E, H, A, C), rule(G, J, B, D)) :-
A==B,
identical_bodies(C, D),
permutation(E, F),
F==G,
permutation(H, I),
I==J.
identical_bodies(A, B) :-
( A= (C=E),
B= (D=F)
-> ( C==D,
E==F
; C==F,
D==E
), !
; A==B
).
copy_with_variable_replacement(A, C, B) :-
( var(A)
-> ( lookup_eq(B, A, C)
-> true
; A=C
)
; functor(A, D, E),
functor(C, D, E),
A=..[_|F],
C=..[_|G],
copy_with_variable_replacement_l(F, G, B)
).
copy_with_variable_replacement_l([], [], _).
copy_with_variable_replacement_l([A|D], [B|E], C) :-
copy_with_variable_replacement(A, B, C),
copy_with_variable_replacement_l(D, E, C).
variable_replacement(A, B, C) :-
variable_replacement(A, B, [], C).
variable_replacement(A, B, C, E) :-
( var(A)
-> var(B),
( lookup_eq(C, A, D)
-> D==B,
E=C
; E=[A-B|C]
)
; A=..[F|G],
nonvar(B),
B=..[F|H],
variable_replacement_l(G, H, C, E)
).
variable_replacement_l([], [], A, A).
variable_replacement_l([A|D], [B|E], C, G) :-
variable_replacement(A, B, C, F),
variable_replacement_l(D, E, F, G).
simplification_code(B, H, J, A, D/C, E, E1, G1) :-
A=pragma(O, _, K, _),
head_info(B, C, _, S, F, G),
build_head(D, C, E, F, Q),
head_arg_matches(G, [], R, I),
( H==[]
-> M=[],
N=I,
L=[]
; rest_heads_retrieval_and_matching(H, J, K, B, L, M, I, N)
),
guard_body_copies2(O, N, P, D1),
guard_via_reschedule(L, P, Q-R, A1),
gen_uncond_susps_detachments(M, H, B1),
gen_cond_susp_detachment(S, D/C, C1),
( chr_pp_flag(debugable, on)
-> O=rule(_, _, T, U),
my_term_copy(T-U, N, _, V-W),
Y='chr debug_event'(try([S|X], [], V, W)),
Z='chr debug_event'(apply([S|X], [], V, W))
; Y=true,
Z=true
),
F1= (Q:-R, A1, Y, !, Z, B1, C1, D1),
E1=[F1|G1].
head_arg_matches(A, B, E, C) :-
head_arg_matches_(A, B, D, C),
list2conj(D, E).
head_arg_matches_([], A, [], A).
head_arg_matches_([A-D|H], B, C, P) :-
( var(A)
-> ( lookup_eq(B, A, E)
-> C=[D==E|G],
F=B
; F=[A-D|B],
C=G
),
I=H
; atomic(A)
-> C=[D==A|G],
B=F,
I=H
; A=..[_|M],
functor(A, J, K),
functor(L, J, K),
L=..[_|N],
C=[nonvar(D), D=L|G],
pairup(M, N, O),
append(O, H, I),
F=B
),
head_arg_matches_(I, F, G, P).
rest_heads_retrieval_and_matching(A, B, C, D, E, F, G, H) :-
rest_heads_retrieval_and_matching(A, B, C, D, E, F, G, H, [], [], []).
rest_heads_retrieval_and_matching(A, B, C, F, G, H, I, J, D, E, K) :-
( A=[_|_]
-> rest_heads_retrieval_and_matching_n(A, B, C, D, E, F, G, H, I, J, K)
; G=[],
H=[],
I=J
).
rest_heads_retrieval_and_matching_n([], _, _, _, _, _, [], [], A, A, B) :-
instantiate_pattern_goals(B).
rest_heads_retrieval_and_matching_n([A|B1], [W|C1], X, C, Q, B, [F, Z|D1], [P|E1], E, G1, D) :-
passive_head_via(A, [B|C], D, E, F, K, H1),
functor(A, L, G),
head_info(A, G, I, _, _, H),
head_arg_matches(H, E, V, F1),
S=..[suspension, _, R, _, _, _, _|I],
get_max_constraint_index(J),
( J==1
-> O=K
; get_constraint_index(L/G, M),
make_attr(J, _, N, K),
nth1(M, N, O)
),
different_from_other_susps(A, P, C, Q, U),
create_get_mutable_ref(active, R, T),
A1= ('chr sbag_member'(P, O), P=S, T, U, V),
( member(unique(W, Y), X),
check_unique_keys(Y, E)
-> Z= (A1->true)
; Z=A1
),
rest_heads_retrieval_and_matching_n(B1, C1, X, [A|C], [P|Q], B, D1, E1, F1, G1, H1).
instantiate_pattern_goals([]).
instantiate_pattern_goals([_-attr(C, D, B)|G]) :-
get_max_constraint_index(A),
( A==1
-> B=true
; make_attr(A, E, _, C),
or_list(D, F), !,
B= (E/\F=:=F)
),
instantiate_pattern_goals(G).
check_unique_keys([], _).
check_unique_keys([B|C], A) :-
lookup_eq(A, B, _),
check_unique_keys(C, A).
different_from_other_susps(C, G, B, E, J) :-
( bagof(F, A^ (nth1(A, B, D), \+C\=D, nth1(A, E, H), F= (G\==H)), I)
-> list2conj(I, J)
; J=true
).
passive_head_via(A, D, I, F, O, K, N) :-
functor(A, B, C),
get_constraint_index(B/C, G),
common_variables(A, D, E),
translate(E, F, H),
or_pattern(G, L),
( permutation(H, J),
lookup_eq(I, J, attr(K, M, _))
-> member(L, M), !,
N=I,
O=true
; O= (P, Q),
gen_get_mod_constraints(H, P, K),
N=[H-attr(K, [L|_], Q)|I]
).
common_variables(A, B, E) :-
term_variables(A, C),
term_variables(B, D),
intersect_eq(C, D, E).
gen_get_mod_constraints(A, B, F) :-
get_target_module(D),
( A==[]
-> B= ('chr default_store'(C), get_attr(C, D, E), E=F)
; ( A=[G]
-> H='chr via_1'(G, J)
; A=[G, I]
-> H='chr via_2'(G, I, J)
; H='chr via'(A, J)
),
B= (H, get_attr(J, D, E), E=F)
).
guard_body_copies(A, B, E, C) :-
guard_body_copies2(A, B, D, C),
list2conj(D, E).
guard_body_copies2(A, D, H, W) :-
A=rule(_, _, B, U),
conj2list(B, C),
split_off_simple_guard(C, D, E, F),
my_term_copy(E-F, D, V, G-I),
append(G, [Q], H),
term_variables(F, L),
term_variables(I, M),
( chr_pp_flag(guard_locks, on),
bagof('chr lock'(J)-'chr unlock'(J), K^ (member(K, L), lookup_eq(D, K, J), memberchk_eq(J, M)), N)
-> once(pairup(O, P, N))
; O=[],
P=[]
),
list2conj(O, R),
list2conj(P, T),
list2conj(I, S),
Q= (R, S, T),
my_term_copy(U, V, W).
split_off_simple_guard([], _, [], []).
split_off_simple_guard([A|D], B, C, F) :-
( simple_guard(A, B)
-> C=[A|E],
split_off_simple_guard(D, B, E, F)
; C=[],
F=[A|D]
).
simple_guard(var(_), _).
simple_guard(nonvar(_), _).
simple_guard(ground(_), _).
simple_guard(number(_), _).
simple_guard(atom(_), _).
simple_guard(integer(_), _).
simple_guard(float(_), _).
simple_guard(_>_, _).
simple_guard(_<_, _).
simple_guard(_=<_, _).
simple_guard(_>=_, _).
simple_guard(_=:=_, _).
simple_guard(_==_, _).
simple_guard(B is _, A) :-
\+lookup_eq(A, B, _).
simple_guard((A, C), B) :-
simple_guard(A, B),
simple_guard(C, B).
simple_guard(\+A, B) :-
simple_guard(A, B).
my_term_copy(A, B, C) :-
my_term_copy(A, B, _, C).
my_term_copy(A, B, D, C) :-
( var(A)
-> ( lookup_eq(B, A, C)
-> D=B
; D=[A-C|B]
)
; functor(A, E, F),
functor(C, E, F),
A=..[_|G],
C=..[_|H],
my_term_copy_list(G, B, D, H)
).
my_term_copy_list([], A, A, []).
my_term_copy_list([A|D], B, F, [C|G]) :-
my_term_copy(A, B, E, C),
my_term_copy_list(D, E, F, G).
gen_cond_susp_detachment(B, A, C) :-
( is_attached(A)
-> gen_uncond_susp_detachment(B, A, D),
C= (var(B)->true;D)
; C=true
).
gen_uncond_susp_detachment(D, A/B, F) :-
( is_attached(A/B)
-> atom_concat_list([detach_, A, /, B], C),
H=..[C, G, D],
( chr_pp_flag(debugable, on)
-> E='chr debug_event'(remove(D))
; E=true
),
F= (E, 'chr remove_constraint_internal'(D, G), H)
; F=true
).
gen_uncond_susps_detachments([], [], true).
gen_uncond_susps_detachments([B|F], [A|G], (E, H)) :-
functor(A, C, D),
gen_uncond_susp_detachment(B, C/D, E),
gen_uncond_susps_detachments(F, G, H).
simpagation_head1_code(C, I, K, A, F/D, G, L1, N1) :-
A=pragma(B, ids(_, L), Q, _),
B=rule(_, J, A1, B1),
head_info(C, D, _, Z, H, E),
head_arg_matches(E, [], X, R),
build_head(F, D, G, H, W),
append(I, J, M),
append(K, L, N),
reorder_heads(C, M, N, O, P),
rest_heads_retrieval_and_matching(O, P, Q, C, U, S, R, T),
split_by_ids(P, S, K, Y, C1),
guard_body_copies2(B, T, V, K1),
guard_via_reschedule(U, V, W-X, H1),
gen_uncond_susps_detachments(Y, I, I1),
gen_cond_susp_detachment(Z, F/D, J1),
( chr_pp_flag(debugable, on)
-> my_term_copy(A1-B1, T, _, D1-E1),
F1='chr debug_event'(try([Z|Y], C1, D1, E1)),
G1='chr debug_event'(apply([Z|Y], C1, D1, E1))
; F1=true,
G1=true
),
M1= (W:-X, H1, F1, !, G1, I1, J1, K1),
L1=[M1|N1].
split_by_ids([], [], _, [], []).
split_by_ids([A|H], [D|I], B, C, E) :-
( memberchk_eq(A, B)
-> C=[D|F],
E=G
; C=F,
E=[D|G]
),
split_by_ids(H, I, B, F, G).
simpagation_head2_code(C, G, P, A, J, K, L, T) :-
A=pragma(B, ids(E, _), Q, _),
B=rule(D, _, H, I),
reorder_heads(C, D, E, [F|N], [M|O]),
simpagation_head2_prelude(C, F, [G, D, H, I], J, K, L, S),
extend_id(K, R),
simpagation_head2_worker(C, F, M, N, O, G, P, B, Q, J, R, S, T).
simpagation_head2_prelude(A, G, T, C/B, D, B1, D1) :-
head_info(A, B, Q, R, E, F),
build_head(C, B, D, E, X),
head_arg_matches(F, [], Y, H),
passive_head_via(G, [A], [], H, Z, K, I),
instantiate_pattern_goals(I),
get_max_constraint_index(J),
( J==1
-> P=K
; functor(G, L, M),
get_constraint_index(L/M, N),
make_attr(J, _, O, K),
nth1(N, O, P)
),
( D==[0]
-> gen_cond_allocation(Q, R, C/B, E, S)
; S=true
),
extend_id(D, V),
extra_active_delegate_variables(A, T, H, U),
append([P|E], U, W),
build_head(C, B, V, W, A1),
C1= (X:-Y, Z, !, S, A1),
B1=[C1|D1].
extra_active_delegate_variables(A, B, C, E) :-
A=..[_|D],
delegate_variables(A, B, C, D, E).
passive_delegate_variables(B, A, C, D, F) :-
term_variables(A, E),
delegate_variables(B, C, D, E, F).
delegate_variables(A, B, H, F, I) :-
term_variables(A, C),
term_variables(B, D),
intersect_eq(C, D, E),
list_difference_eq(E, F, G),
translate(G, H, I).
simpagation_head2_worker(B, C, K, D, L, E, M, A, N, H, I, J, P) :-
A=rule(_, _, F, G),
simpagation_head2_worker_end(B, [C, D, E, F, G], H, I, J, O),
simpagation_head2_worker_body(B, C, K, D, L, E, M, A, N, H, I, O, P).
simpagation_head2_worker_body(A, E, C2, F, X, G, Y, D, D1, O/B, P, H2, I2) :-
gen_var(K),
gen_var(L),
head_info(A, B, _, R1, M, C),
head_arg_matches(C, [], _, J),
D=rule(_, _, H, I),
extra_active_delegate_variables(A, [E, F, G, H, I], J, N),
append([[K|L]|M], N, Q),
build_head(O, B, P, Q, N1),
functor(E, _, R),
head_info(E, R, T, _, _, S),
head_arg_matches(S, J, P1, E1),
V=..[suspension, _, U, _, _, _, _|T],
create_get_mutable_ref(active, U, W),
O1= (K=V, W),
( ( F\==[]
; G\==[]
)
-> append(F, G, Z),
append(X, Y, A1),
reorder_heads(E-A, Z, A1, B1, C1),
rest_heads_retrieval_and_matching(B1, C1, D1, [E, A], G1, F1, E1, J1, [E], [K], []),
split_by_ids(C1, F1, X, H1, I1)
; G1=[],
H1=[],
I1=[],
J1=E1
),
gen_uncond_susps_detachments([K|H1], [E|F], F2),
append([L|M], N, K1),
build_head(O, B, P, K1, S1),
append([[]|M], N, L1),
build_head(O, B, P, L1, U1),
guard_body_copies2(D, J1, M1, Q1),
guard_via_reschedule(G1, M1, v(N1, O1, P1), E2),
( Q1\==true
-> gen_uncond_attach_goal(O/B, R1, V1, T1),
gen_state_cond_call(R1, B, S1, T1, W1),
gen_state_cond_call(R1, B, U1, T1, X1)
; V1=true,
W1=S1,
X1=U1
),
( chr_pp_flag(debugable, on)
-> my_term_copy(H-I, J1, _, Y1-Z1),
A2='chr debug_event'(try([K|H1], [R1|I1], Y1, Z1)),
B2='chr debug_event'(apply([K|H1], [R1|I1], Y1, Z1))
; A2=true,
B2=true
),
( member(unique(C2, D2), D1),
check_unique_keys(D2, J)
-> G2= (N1:-O1, P1-> (E2, A2->B2, F2, V1, Q1, X1;U1);S1)
; G2= (N1:-O1, P1, E2, A2->B2, F2, V1, Q1, W1;S1)
),
H2=[G2|I2].
gen_state_cond_call(G, A, K, D, F) :-
length(B, A),
H=..[suspension, _, C, _, E, _, _|B],
create_get_mutable_ref(active, C, I),
create_get_mutable_ref(D, E, J),
F= (G=H, I, J->'chr update_mutable'(inactive, C), K;true).
simpagation_head2_worker_end(A, D, H/B, I, N, P) :-
head_info(A, B, _, _, F, C),
head_arg_matches(C, [], _, E),
extra_active_delegate_variables(A, D, E, G),
append([[]|F], G, J),
build_head(H, B, I, J, L),
next_id(I, K),
build_head(H, B, K, F, M),
O= (L:-M),
N=[O|P].
propagation_code(B, A, C, D, I, E, F, G, H) :-
( A==[]
-> propagation_single_headed(B, C, D, E, F, G, H)
; propagation_multi_headed(B, A, C, D, I, E, F, G, H)
).
propagation_single_headed(A, I, Y, C/B, D, D1, F1) :-
head_info(A, B, K, L, E, H),
build_head(C, B, D, E, W),
inc_id(D, F),
build_head(C, B, F, E, G),
O=G,
head_arg_matches(H, [], X, J),
guard_body_copies(I, J, Z, B1),
( D==[0]
-> gen_cond_allocation(K, L, C/B, E, M),
N=M
; N=true
),
gen_uncond_attach_goal(C/B, L, A1, P),
gen_state_cond_call(L, B, O, P, C1),
( chr_pp_flag(debugable, on)
-> I=rule(_, _, Q, R),
my_term_copy(Q-R, J, _, S-T),
U='chr debug_event'(try([], [L], S, T)),
V='chr debug_event'(apply([], [L], S, T))
; U=true,
V=true
),
E1= (W:-X, N, 'chr novel_production'(L, Y), Z, U, !, V, 'chr extend_history'(L, Y), A1, B1, C1),
D1=[E1|F1].
propagation_multi_headed(B, A, C, I, J, D, E, F, M) :-
A=[H|G],
propagation_prelude(B, A, C, D, E, F, L),
extend_id(E, K),
propagation_nested_code(G, [H, B], C, I, J, D, K, L, M).
propagation_prelude(A, [H|I], G, C/B, D, F1, H1) :-
head_info(A, B, U, V, E, F),
build_head(C, B, D, E, B1),
head_arg_matches(F, [], C1, L),
G=rule(_, _, J, K),
extra_active_delegate_variables(A, [H, I, J, K], L, X),
passive_head_via(H, [A], [], L, D1, O, M),
instantiate_pattern_goals(M),
get_max_constraint_index(N),
( N==1
-> T=O
; functor(H, P, Q),
make_attr(N, _, S, O),
get_constraint_index(P/Q, R),
nth1(R, S, T)
),
( D==[0]
-> gen_cond_allocation(U, V, C/B, E, W)
; W=true
),
extend_id(D, Y),
append([T|E], X, Z),
build_head(C, B, Y, Z, A1),
E1=A1,
G1= (B1:-C1, D1, !, W, E1),
F1=[G1|H1].
propagation_nested_code([], [A|B], C, G, H, D, E, F, J) :-
propagation_end([A|B], [], C, D, E, F, I),
propagation_body(A, B, C, G, H, D, E, I, J).
propagation_nested_code([B|C], A, D, I, J, E, F, G, M) :-
propagation_end(A, [B|C], D, E, F, G, H),
propagation_accumulator([B|C], A, D, E, F, H, L),
inc_id(F, K),
propagation_nested_code(C, [B|A], D, I, J, E, K, L, M).
propagation_body(C, B, A, G1, B1, N/O, P, W1, Y1) :-
A=rule(_, _, D, E),
get_prop_inner_loop_vars(B, [C, D, E], M, V, Y, W),
gen_var(I),
gen_var(L),
functor(C, _, F),
gen_vars(F, G),
J=..[suspension, _, H, _, _, _, _|G],
create_get_mutable_ref(active, H, K),
M1= (I=J, K),
Q=[[I|L]|M],
build_head(N, O, P, Q, L1),
R=[L|M],
build_head(N, O, P, R, S),
Z=S,
C=..[_|T],
pairup(T, G, U),
head_arg_matches(U, V, O1, X),
different_from_other_susps(C, I, B, W, N1),
guard_body_copies(A, X, S1, U1),
gen_uncond_attach_goal(N/O, Y, T1, A1),
gen_state_cond_call(Y, O, Z, A1, V1),
history_susps(B1, [I|W], Y, [], D1),
bagof('chr novel_production'(C1, E1), (member(C1, D1), E1=P1), F1),
list2conj(F1, R1),
Q1=..[t, G1|D1],
( chr_pp_flag(debugable, on)
-> A=rule(_, _, D, E),
my_term_copy(D-E, X, _, H1-I1),
J1='chr debug_event'(try([], [Y, I|W], H1, I1)),
K1='chr debug_event'(apply([], [Y, I|W], H1, I1))
; J1=true,
K1=true
),
X1= (L1:-M1, N1, O1, P1=Q1, R1, S1, J1->K1, 'chr extend_history'(Y, P1), T1, U1, V1;Z),
W1=[X1|Y1].
history_susps(A, B, D, E, F) :-
( A==0
-> reverse(B, C),
append(C, [D|E], F)
; B=[I|H],
G is A-1,
history_susps(G, H, D, [I|E], F)
).
get_prop_inner_loop_vars([A], F, I, E, C, []) :- !,
functor(A, _, B),
head_info(A, B, _, C, G, D),
head_arg_matches(D, [], _, E),
extra_active_delegate_variables(A, F, E, H),
append(G, H, I).
get_prop_inner_loop_vars([B|A], C, N, J, D, [G|E]) :-
get_prop_inner_loop_vars(A, [B|C], M, I, D, E),
functor(B, _, F),
gen_var(L),
head_info(B, F, _, G, _, H),
head_arg_matches(H, I, _, J),
passive_delegate_variables(B, A, C, J, K),
append(K, [G, L|M], N).
propagation_end([C|B], D, A, H/I, J, S, U) :-
A=rule(_, _, E, F),
gen_var_susp_list_for(B, [C, D, E, F], _, G, L, O),
K=[[]|G],
build_head(H, I, J, K, Q),
( J=[0|_]
-> next_id(J, M),
N=L
; dec_id(J, M),
N=[O|L]
),
build_head(H, I, M, N, P),
R=P,
T= (Q:-R),
S=[T|U].
gen_var_susp_list_for([A], G, F, I, D, C) :- !,
functor(A, _, B),
head_info(A, B, _, C, D, E),
head_arg_matches(E, [], _, F),
extra_active_delegate_variables(A, G, F, H),
append(D, H, I).
gen_var_susp_list_for([B|A], C, I, L, D, E) :-
gen_var_susp_list_for(A, [B|C], H, D, _, _),
functor(B, _, F),
gen_var(E),
head_info(B, F, _, K, _, G),
head_arg_matches(G, H, _, I),
passive_delegate_variables(B, A, C, I, J),
append(J, [K, E|D], L).
propagation_accumulator([D|E], [C|B], A, E1/F1, B1, Q1, S1) :-
A=rule(_, _, F, G),
pre_vars_and_susps(B, [C, D, E, F, G], D1, K, M),
gen_var(C1),
functor(C, _, H),
gen_vars(H, I),
head_info(C, H, I, L, _, J),
head_arg_matches(J, K, R, S),
O=..[suspension, _, N, _, _, _, _|I],
different_from_other_susps(C, L, B, M, Q),
create_get_mutable_ref(active, N, P),
M1= (L=O, P, Q, R),
functor(D, W, X),
passive_head_via(D, [C|B], [], S, N1, V, T),
instantiate_pattern_goals(T),
get_max_constraint_index(U),
( U==1
-> A1=V
; get_constraint_index(W/X, Y),
make_attr(U, _, Z, V),
nth1(Y, Z, A1)
),
inc_id(B1, I1),
G1=[[L|C1]|D1],
build_head(E1, F1, B1, G1, L1),
passive_delegate_variables(C, B, [D, E, F, G], S, H1),
append([A1|H1], [L, C1|D1], J1),
build_head(E1, F1, I1, J1, O1),
K1=[C1|D1],
build_head(E1, F1, B1, K1, P1),
R1= (L1:-M1, N1->O1;P1),
Q1=[R1|S1].
pre_vars_and_susps([A], E, H, D, []) :- !,
functor(A, _, B),
head_info(A, B, _, _, F, C),
head_arg_matches(C, [], _, D),
extra_active_delegate_variables(A, E, D, G),
append(F, G, H).
pre_vars_and_susps([B|A], C, M, I, [F|D]) :-
pre_vars_and_susps(A, [B|C], L, H, D),
functor(B, _, E),
gen_var(K),
head_info(B, E, _, F, _, G),
head_arg_matches(G, H, _, I),
passive_delegate_variables(B, A, C, I, J),
append(J, [F, K|L], M).
reorder_heads(A, B, C, D, E) :-
( chr_pp_flag(reorder_heads, on)
-> reorder_heads_main(A, B, C, D, E)
; D=B,
E=C
).
reorder_heads_main(A, B, C, E, F) :-
term_variables(A, D),
reorder_heads1(B, C, D, E, F).
reorder_heads1(A, D, E, B, C) :-
( A==[]
-> B=[],
C=[]
; B=[F|K],
C=[G|L],
select_best_head(A, D, E, F, G, H, I, J),
reorder_heads1(H, I, J, K, L)
).
select_best_head(C, D, G, J, K, L, M, Q) :-
( bagof(tuple(H, A, B, E, F), (select2(A, B, C, D, E, F), order_score(A, G, E, H)), I)
-> true
; I=[]
),
max_go_list(I, tuple(_, J, K, L, M)),
term_variables(J, O),
( setof(N, (member(N, O), \+memberchk_eq(N, G)), P)
-> true
; P=[]
),
append(P, G, Q).
reorder_heads(A, B, D) :-
term_variables(A, C),
reorder_heads1(B, C, D).
reorder_heads1(A, C, B) :-
( A==[]
-> B=[]
; B=[D|G],
select_best_head(A, C, D, E, F),
reorder_heads1(E, F, G)
).
select_best_head(B, D, G, H, L) :-
( bagof(tuple(E, A, C), (select(A, B, C), order_score(A, D, C, E)), F)
-> true
; F=[]
),
max_go_list(F, tuple(_, G, H)),
term_variables(G, J),
( setof(I, (member(I, J), \+memberchk_eq(I, D)), K)
-> true
; K=[]
),
append(K, D, L).
order_score(A, D, B, F) :-
term_variables(A, C),
term_variables(B, E),
order_score_vars(C, D, E, 0, F).
order_score_vars([], _, _, A, B) :-
( A==0
-> B=99999
; B=A
).
order_score_vars([A|F], B, D, C, G) :-
( memberchk_eq(A, B)
-> E is C+1
; memberchk_eq(A, D)
-> E is C+1
; E=C
),
order_score_vars(F, B, D, E, G).
create_get_mutable_ref(C, B, A) :-
A= (B=mutable(C)).
clean_clauses([], []).
clean_clauses([A|C], [B|D]) :-
clean_clause(A, B),
clean_clauses(C, D).
clean_clause(A, D) :-
( A= (E:-B)
-> clean_goal(B, C),
( C==true
-> D=E
; D= (E:-C)
)
; D=A
).
clean_goal(A, B) :-
var(A), !,
B=A.
clean_goal((A, B), D) :- !,
clean_goal(A, C),
clean_goal(B, E),
( C==true
-> D=E
; E==true
-> D=C
; D= (C, E)
).
clean_goal((A->C;F), D) :- !,
clean_goal(A, B),
( B==true
-> clean_goal(C, E),
D=E
; B==fail
-> clean_goal(F, G),
D=G
; clean_goal(C, E),
clean_goal(F, G),
D= (B->E;G)
).
clean_goal((A;B), D) :- !,
clean_goal(A, C),
clean_goal(B, E),
( C==fail
-> D=E
; E==fail
-> D=C
; D= (C;E)
).
clean_goal(once(A), C) :- !,
clean_goal(A, B),
( B==true
-> C=true
; B==fail
-> C=fail
; C=once(B)
).
clean_goal((A->C), D) :- !,
clean_goal(A, B),
( B==true
-> clean_goal(C, D)
; B==fail
-> D=fail
; clean_goal(C, E),
D= (B->E)
).
clean_goal(A, A).
gen_var(_).
gen_vars(B, A) :-
length(A, B).
head_info(E, A, B, C, D, G) :-
vars_susp(A, B, C, D),
E=..[_|F],
pairup(F, B, G).
inc_id([C|A], [B|A]) :-
B is C+1.
dec_id([C|A], [B|A]) :-
B is C-1.
extend_id(A, [0|A]).
next_id([_, C|A], [B|A]) :-
B is C+1.
build_head(A, B, C, F, D) :-
buildName(A, B, C, E),
D=..[E|F].
buildName(A, C, D, F) :-
atom_concat(A, /, B),
atomic_concat(B, C, E),
buildName_(D, E, F).
buildName_([], A, A).
buildName_([E|A], B, F) :-
buildName_(A, B, C),
atom_concat(C, '__', D),
atomic_concat(D, E, F).
vars_susp(B, A, C, D) :-
length(A, B),
append(A, [C], D).
make_attr(B, D, A, C) :-
length(A, B),
C=..[v, D|A].
or_pattern(A, B) :-
C is A-1,
B is 1<<C.
and_pattern(A, C) :-
B is A-1,
D is 1<<B,
C is-1* (D+1).
conj2list(A, B) :-
conj2list(A, B, []).
conj2list(A, C, F) :-
A= (B, D), !,
conj2list(B, C, E),
conj2list(D, E, F).
conj2list(A, [A|B], B).
list2conj([], true).
list2conj([B], A) :- !,
A=B.
list2conj([A|B], C) :-
( A==true
-> list2conj(B, C)
; C= (A, D),
list2conj(B, D)
).
atom_concat_list([A], A) :- !.
atom_concat_list([B|A], D) :-
atom_concat_list(A, C),
atomic_concat(B, C, D).
make_atom(A, B) :-
( atom(A)
-> B=A
; number(A)
-> number_codes(A, C),
atom_codes(B, C)
).
set_elems([], _).
set_elems([A|B], A) :-
set_elems(B, A).
member2([A|_], [B|_], A-B).
member2([_|A], [_|B], C) :-
member2(A, B, C).
select2(A, B, [A|C], [B|D], C, D).
select2(C, D, [A|E], [B|F], [A|G], [B|H]) :-
select2(C, D, E, F, G, H).
pair_all_with([], _, []).
pair_all_with([A|C], B, [A-B|D]) :-
pair_all_with(C, B, D).
verbosity_on :-
prolog_flag(verbose, A),
A==yes.
'attach_constraint/2'([], _).
'attach_constraint/2'([A|L], D) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, E, F, G, H, I, J),
( C/\1=:=1
-> put_attr(A, chr_translate_bootstrap1, v(C, [D|E], F, G, H, I, J))
; K is C\/1,
put_attr(A, chr_translate_bootstrap1, v(K, [D], F, G, H, I, J))
)
; put_attr(A, chr_translate_bootstrap1, v(1, [D], [], [], [], [], []))
),
'attach_constraint/2'(L, D).
'detach_constraint/2'([], _).
'detach_constraint/2'([A|M], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, D, H, I, J, K, L),
( C/\1=:=1
-> 'chr sbag_del_element'(D, E, F),
( F==[]
-> G is C/\ -2,
( G==0
-> del_attr(A, chr_translate_bootstrap1)
; put_attr(A, chr_translate_bootstrap1, v(G, [], H, I, J, K, L))
)
; put_attr(A, chr_translate_bootstrap1, v(C, F, H, I, J, K, L))
)
; true
)
; true
),
'detach_constraint/2'(M, E).
'attach_constraint_count/1'([], _).
'attach_constraint_count/1'([A|L], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, D, F, G, H, I, J),
( C/\2=:=2
-> put_attr(A, chr_translate_bootstrap1, v(C, D, [E|F], G, H, I, J))
; K is C\/2,
put_attr(A, chr_translate_bootstrap1, v(K, D, [E], G, H, I, J))
)
; put_attr(A, chr_translate_bootstrap1, v(2, [], [E], [], [], [], []))
),
'attach_constraint_count/1'(L, E).
'detach_constraint_count/1'([], _).
'detach_constraint_count/1'([A|M], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, H, D, I, J, K, L),
( C/\2=:=2
-> 'chr sbag_del_element'(D, E, F),
( F==[]
-> G is C/\ -3,
( G==0
-> del_attr(A, chr_translate_bootstrap1)
; put_attr(A, chr_translate_bootstrap1, v(G, H, [], I, J, K, L))
)
; put_attr(A, chr_translate_bootstrap1, v(C, H, F, I, J, K, L))
)
; true
)
; true
),
'detach_constraint_count/1'(M, E).
'attach_constraint_index/2'([], _).
'attach_constraint_index/2'([A|L], F) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, D, E, G, H, I, J),
( C/\4=:=4
-> put_attr(A, chr_translate_bootstrap1, v(C, D, E, [F|G], H, I, J))
; K is C\/4,
put_attr(A, chr_translate_bootstrap1, v(K, D, E, [F], H, I, J))
)
; put_attr(A, chr_translate_bootstrap1, v(4, [], [], [F], [], [], []))
),
'attach_constraint_index/2'(L, F).
'detach_constraint_index/2'([], _).
'detach_constraint_index/2'([A|M], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, H, I, D, J, K, L),
( C/\4=:=4
-> 'chr sbag_del_element'(D, E, F),
( F==[]
-> G is C/\ -5,
( G==0
-> del_attr(A, chr_translate_bootstrap1)
; put_attr(A, chr_translate_bootstrap1, v(G, H, I, [], J, K, L))
)
; put_attr(A, chr_translate_bootstrap1, v(C, H, I, F, J, K, L))
)
; true
)
; true
),
'detach_constraint_index/2'(M, E).
'attach_max_constraint_index/1'([], _).
'attach_max_constraint_index/1'([A|L], G) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, D, E, F, H, I, J),
( C/\8=:=8
-> put_attr(A, chr_translate_bootstrap1, v(C, D, E, F, [G|H], I, J))
; K is C\/8,
put_attr(A, chr_translate_bootstrap1, v(K, D, E, F, [G], I, J))
)
; put_attr(A, chr_translate_bootstrap1, v(8, [], [], [], [G], [], []))
),
'attach_max_constraint_index/1'(L, G).
'detach_max_constraint_index/1'([], _).
'detach_max_constraint_index/1'([A|M], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, H, I, J, D, K, L),
( C/\8=:=8
-> 'chr sbag_del_element'(D, E, F),
( F==[]
-> G is C/\ -9,
( G==0
-> del_attr(A, chr_translate_bootstrap1)
; put_attr(A, chr_translate_bootstrap1, v(G, H, I, J, [], K, L))
)
; put_attr(A, chr_translate_bootstrap1, v(C, H, I, J, F, K, L))
)
; true
)
; true
),
'detach_max_constraint_index/1'(M, E).
'attach_target_module/1'([], _).
'attach_target_module/1'([A|L], H) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, D, E, F, G, I, J),
( C/\16=:=16
-> put_attr(A, chr_translate_bootstrap1, v(C, D, E, F, G, [H|I], J))
; K is C\/16,
put_attr(A, chr_translate_bootstrap1, v(K, D, E, F, G, [H], J))
)
; put_attr(A, chr_translate_bootstrap1, v(16, [], [], [], [], [H], []))
),
'attach_target_module/1'(L, H).
'detach_target_module/1'([], _).
'detach_target_module/1'([A|M], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, H, I, J, K, D, L),
( C/\16=:=16
-> 'chr sbag_del_element'(D, E, F),
( F==[]
-> G is C/\ -17,
( G==0
-> del_attr(A, chr_translate_bootstrap1)
; put_attr(A, chr_translate_bootstrap1, v(G, H, I, J, K, [], L))
)
; put_attr(A, chr_translate_bootstrap1, v(C, H, I, J, K, F, L))
)
; true
)
; true
),
'detach_target_module/1'(M, E).
'attach_attached/2'([], _).
'attach_attached/2'([A|L], I) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, D, E, F, G, H, J),
( C/\32=:=32
-> put_attr(A, chr_translate_bootstrap1, v(C, D, E, F, G, H, [I|J]))
; K is C\/32,
put_attr(A, chr_translate_bootstrap1, v(K, D, E, F, G, H, [I]))
)
; put_attr(A, chr_translate_bootstrap1, v(32, [], [], [], [], [], [I]))
),
'attach_attached/2'(L, I).
'detach_attached/2'([], _).
'detach_attached/2'([A|M], E) :-
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(C, H, I, J, K, L, D),
( C/\32=:=32
-> 'chr sbag_del_element'(D, E, F),
( F==[]
-> G is C/\ -33,
( G==0
-> del_attr(A, chr_translate_bootstrap1)
; put_attr(A, chr_translate_bootstrap1, v(G, H, I, J, K, L, []))
)
; put_attr(A, chr_translate_bootstrap1, v(C, H, I, J, K, L, F))
)
; true
)
; true
),
'detach_attached/2'(M, E).
attach_increment([], _).
attach_increment([A|D1], v(U, D, G, J, M, P, S)) :-
'chr not_locked'(A),
( get_attr(A, chr_translate_bootstrap1, B)
-> B=v(V, C, F, I, L, O, R),
sort(C, E),
'chr merge_attributes'(D, E, X),
sort(F, H),
'chr merge_attributes'(G, H, Y),
sort(I, K),
'chr merge_attributes'(J, K, Z),
sort(L, N),
'chr merge_attributes'(M, N, A1),
sort(O, Q),
'chr merge_attributes'(P, Q, B1),
sort(R, T),
'chr merge_attributes'(S, T, C1),
W is U\/V,
put_attr(A, chr_translate_bootstrap1, v(W, X, Y, Z, A1, B1, C1))
; put_attr(A, chr_translate_bootstrap1, v(U, D, G, J, M, P, S))
),
attach_increment(D1, v(U, D, G, J, M, P, S)).
chr_translate_bootstrap1:attr_unify_hook(v(A1, A, B, C, D, E, F), G) :-
sort(A, J),
sort(B, M),
sort(C, P),
sort(D, S),
sort(E, V),
sort(F, Y),
( var(G)
-> ( get_attr(G, chr_translate_bootstrap1, H)
-> H=v(B1, I, L, O, R, U, X),
sort(I, K),
'chr merge_attributes'(J, K, D1),
sort(L, N),
'chr merge_attributes'(M, N, E1),
sort(O, Q),
'chr merge_attributes'(P, Q, F1),
sort(R, T),
'chr merge_attributes'(S, T, G1),
sort(U, W),
'chr merge_attributes'(V, W, H1),
sort(X, Z),
'chr merge_attributes'(Y, Z, I1),
C1 is A1\/B1,
put_attr(G, chr_translate_bootstrap1, v(C1, D1, E1, F1, G1, H1, I1)),
'chr run_suspensions_loop'([D1, E1, F1, G1, H1, I1])
; put_attr(G, chr_translate_bootstrap1, v(A1, J, M, P, S, V, Y)),
'chr run_suspensions_loop'([J, M, P, S, V, Y])
)
; ( compound(G)
-> term_variables(G, J1),
attach_increment(J1, v(A1, J, M, P, S, V, Y))
; true
),
'chr run_suspensions_loop'([J, M, P, S, V, Y])
).
constraint(A, B) :-
'constraint/2__0'(A, B, _).
'constraint/2__0'(A, K, I) :-
'chr via_1'(A, B),
get_attr(B, chr_translate_bootstrap1, C),
C=v(D, E, _, _, _, _, _),
D/\1=:=1,
( 'chr sbag_member'(F, E),
F=suspension(_, G, _, _, _, _, H, L),
G=mutable(active),
H==A
-> true
), !,
( var(I)
-> true
; 'chr remove_constraint_internal'(I, J),
'detach_constraint/2'(J, I)
),
K=L.
'constraint/2__0'(K, A, I) :-
'chr via_1'(A, B),
get_attr(B, chr_translate_bootstrap1, C),
C=v(D, E, _, _, _, _, _),
D/\1=:=1,
'chr sbag_member'(F, E),
F=suspension(_, G, _, _, _, _, L, H),
G=mutable(active),
H==A, !,
( var(I)
-> true
; 'chr remove_constraint_internal'(I, J),
'detach_constraint/2'(J, I)
),
K=L.
'constraint/2__0'(B, C, A) :-
( var(A)
-> 'chr insert_constraint_internal'(D, A, chr_translate_bootstrap1:'constraint/2__0'(B, C, A), constraint, [B, C])
; 'chr activate_constraint'(D, A, _)
),
'attach_constraint/2'(D, A).
constraint_count(A) :-
'constraint_count/1__0'(A, _).
'constraint_count/1__0'(I, G) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, D, _, _, _, _),
C/\2=:=2,
'chr sbag_member'(E, D),
E=suspension(_, F, _, _, _, _, J),
F=mutable(active), !,
( var(G)
-> true
; 'chr remove_constraint_internal'(G, H),
'detach_constraint_count/1'(H, G)
),
I=J.
'constraint_count/1__0'(B, A) :-
( var(A)
-> 'chr insert_constraint_internal'(C, A, chr_translate_bootstrap1:'constraint_count/1__0'(B, A), constraint_count, [B])
; 'chr activate_constraint'(C, A, _)
),
'attach_constraint_count/1'(C, A).
constraint_index(A, B) :-
'constraint_index/2__0'(A, B, _).
'constraint_index/2__0'(B, C, A) :-
( var(A)
-> 'chr insert_constraint_internal'(D, A, chr_translate_bootstrap1:'constraint_index/2__0'(B, C, A), constraint_index, [B, C])
; 'chr activate_constraint'(D, A, _)
),
'attach_constraint_index/2'(D, A).
get_constraint_index(A, B) :-
'get_constraint_index/2__0'(A, B, _).
'get_constraint_index/2__0'(A, I, _) :-
'chr via_1'(A, B),
get_attr(B, chr_translate_bootstrap1, C),
C=v(D, _, _, E, _, _, _),
D/\4=:=4,
'chr sbag_member'(F, E),
F=suspension(_, G, _, _, _, _, H, J),
G=mutable(active),
H==A, !,
I=J.
'get_constraint_index/2__0'(_, _, _) :- !,
fail.
max_constraint_index(A) :-
'max_constraint_index/1__0'(A, _).
'max_constraint_index/1__0'(B, A) :-
( var(A)
-> 'chr insert_constraint_internal'(C, A, chr_translate_bootstrap1:'max_constraint_index/1__0'(B, A), max_constraint_index, [B])
; 'chr activate_constraint'(C, A, _)
),
'attach_max_constraint_index/1'(C, A).
get_max_constraint_index(A) :-
'get_max_constraint_index/1__0'(A, _).
'get_max_constraint_index/1__0'(G, _) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, _, _, D, _, _),
C/\8=:=8,
'chr sbag_member'(E, D),
E=suspension(_, F, _, _, _, _, H),
F=mutable(active), !,
G=H.
'get_max_constraint_index/1__0'(_, _) :- !,
fail.
target_module(A) :-
'target_module/1__0'(A, _).
'target_module/1__0'(B, A) :-
( var(A)
-> 'chr insert_constraint_internal'(C, A, chr_translate_bootstrap1:'target_module/1__0'(B, A), target_module, [B])
; 'chr activate_constraint'(C, A, _)
),
'attach_target_module/1'(C, A).
get_target_module(A) :-
'get_target_module/1__0'(A, _).
'get_target_module/1__0'(G, _) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, _, _, _, D, _),
C/\16=:=16,
'chr sbag_member'(E, D),
E=suspension(_, F, _, _, _, _, H),
F=mutable(active), !,
G=H.
'get_target_module/1__0'(A, _) :- !,
A=user.
attached(A, B) :-
'attached/2__0'(A, B, _).
'attached/2__0'(A, _, J) :-
'chr via_1'(A, B),
get_attr(B, chr_translate_bootstrap1, C),
C=v(D, _, _, _, _, _, E),
D/\32=:=32,
'chr sbag_member'(F, E),
F=suspension(_, G, _, _, _, _, H, I),
G=mutable(active),
H==A,
I==yes, !,
( var(J)
-> true
; 'chr remove_constraint_internal'(J, K),
'detach_attached/2'(K, J)
).
'attached/2__0'(B, A, F) :-
A==yes,
'chr via_1'(B, C),
get_attr(C, chr_translate_bootstrap1, D),
D=v(E, _, _, _, _, _, G),
E/\32=:=32, !,
( var(F)
-> 'chr allocate_constraint'(chr_translate_bootstrap1:'attached/2__0'(B, A, F), F, attached, [B, A])
; true
),
'attached/2__0__0'(G, B, A, F).
'attached/2__0__0'([], A, B, C) :-
'attached/2__1'(A, B, C).
'attached/2__0__0'([A|F], D, G, H) :-
( A=suspension(_, B, _, _, _, _, C, _),
B=mutable(active),
C==D
-> 'chr remove_constraint_internal'(A, E),
'detach_attached/2'(E, A),
'attached/2__0__0'(F, D, G, H)
; 'attached/2__0__0'(F, D, G, H)
).
'attached/2__0'(B, C, A) :-
( var(A)
-> 'chr allocate_constraint'(chr_translate_bootstrap1:'attached/2__0'(B, C, A), A, attached, [B, C])
; true
),
'attached/2__1'(B, C, A).
'attached/2__1'(A, _, J) :-
'chr via_1'(A, B),
get_attr(B, chr_translate_bootstrap1, C),
C=v(D, _, _, _, _, _, E),
D/\32=:=32,
'chr sbag_member'(F, E),
F=suspension(_, G, _, _, _, _, H, I),
G=mutable(active),
H==A,
I==no, !,
( var(J)
-> true
; 'chr remove_constraint_internal'(J, K),
'detach_attached/2'(K, J)
).
'attached/2__1'(B, A, G) :-
A==no,
'chr via_1'(B, C),
get_attr(C, chr_translate_bootstrap1, D),
D=v(E, _, _, _, _, _, F),
E/\32=:=32, !,
'attached/2__1__0'(F, B, A, G).
'attached/2__1__0'([], A, B, C) :-
'attached/2__2'(A, B, C).
'attached/2__1__0'([A|F], D, G, H) :-
( A=suspension(_, B, _, _, _, _, C, _),
B=mutable(active),
C==D
-> 'chr remove_constraint_internal'(A, E),
'detach_attached/2'(E, A),
'attached/2__1__0'(F, D, G, H)
; 'attached/2__1__0'(F, D, G, H)
).
'attached/2__1'(A, B, C) :-
'attached/2__2'(A, B, C).
'attached/2__2'(B, A, K) :-
A==maybe,
'chr via_1'(B, C),
get_attr(C, chr_translate_bootstrap1, D),
D=v(E, _, _, _, _, _, F),
E/\32=:=32,
( 'chr sbag_member'(G, F),
G=suspension(_, H, _, _, _, _, I, J),
H=mutable(active),
I==B,
J==maybe
-> true
), !,
( var(K)
-> true
; 'chr remove_constraint_internal'(K, L),
'detach_attached/2'(L, K)
).
'attached/2__2'(_, _, A) :-
'chr activate_constraint'(B, A, _),
'attach_attached/2'(B, A).
is_attached(A) :-
'is_attached/1__0'(A, _).
'is_attached/1__0'(A, _) :-
'chr via_1'(A, B),
get_attr(B, chr_translate_bootstrap1, C),
C=v(D, _, _, _, _, _, E),
D/\32=:=32,
'chr sbag_member'(F, E),
F=suspension(_, G, _, _, _, _, H, I),
G=mutable(active),
H==A, !,
( I==no
-> fail
; true
).
'is_attached/1__0'(_, _) :- !.
chr_clear :-
'chr_clear/0__0'(_).
'chr_clear/0__0'(D) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, E, _, _, _, _, _),
C/\1=:=1, !,
( var(D)
-> 'chr allocate_constraint'(chr_translate_bootstrap1:'chr_clear/0__0'(D), D, chr_clear, [])
; true
),
'chr_clear/0__0__0'(E, D).
'chr_clear/0__0__0'([], A) :-
'chr_clear/0__1'(A).
'chr_clear/0__0__0'([A|D], E) :-
( A=suspension(_, B, _, _, _, _, _, _),
B=mutable(active)
-> 'chr remove_constraint_internal'(A, C),
'detach_constraint/2'(C, A),
'chr_clear/0__0__0'(D, E)
; 'chr_clear/0__0__0'(D, E)
).
'chr_clear/0__0'(A) :-
( var(A)
-> 'chr allocate_constraint'(chr_translate_bootstrap1:'chr_clear/0__0'(A), A, chr_clear, [])
; true
),
'chr_clear/0__1'(A).
'chr_clear/0__1'(E) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, D, _, _, _, _),
C/\2=:=2, !,
'chr_clear/0__1__0'(D, E).
'chr_clear/0__1__0'([], A) :-
'chr_clear/0__2'(A).
'chr_clear/0__1__0'([A|D], E) :-
( A=suspension(_, B, _, _, _, _, _),
B=mutable(active)
-> 'chr remove_constraint_internal'(A, C),
'detach_constraint_count/1'(C, A),
'chr_clear/0__1__0'(D, E)
; 'chr_clear/0__1__0'(D, E)
).
'chr_clear/0__1'(A) :-
'chr_clear/0__2'(A).
'chr_clear/0__2'(E) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, _, D, _, _, _),
C/\4=:=4, !,
'chr_clear/0__2__0'(D, E).
'chr_clear/0__2__0'([], A) :-
'chr_clear/0__3'(A).
'chr_clear/0__2__0'([A|D], E) :-
( A=suspension(_, B, _, _, _, _, _, _),
B=mutable(active)
-> 'chr remove_constraint_internal'(A, C),
'detach_constraint_index/2'(C, A),
'chr_clear/0__2__0'(D, E)
; 'chr_clear/0__2__0'(D, E)
).
'chr_clear/0__2'(A) :-
'chr_clear/0__3'(A).
'chr_clear/0__3'(E) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, _, _, D, _, _),
C/\8=:=8, !,
'chr_clear/0__3__0'(D, E).
'chr_clear/0__3__0'([], A) :-
'chr_clear/0__4'(A).
'chr_clear/0__3__0'([A|D], E) :-
( A=suspension(_, B, _, _, _, _, _),
B=mutable(active)
-> 'chr remove_constraint_internal'(A, C),
'detach_max_constraint_index/1'(C, A),
'chr_clear/0__3__0'(D, E)
; 'chr_clear/0__3__0'(D, E)
).
'chr_clear/0__3'(A) :-
'chr_clear/0__4'(A).
'chr_clear/0__4'(E) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, _, _, _, D, _),
C/\16=:=16, !,
'chr_clear/0__4__0'(D, E).
'chr_clear/0__4__0'([], A) :-
'chr_clear/0__5'(A).
'chr_clear/0__4__0'([A|D], E) :-
( A=suspension(_, B, _, _, _, _, _),
B=mutable(active)
-> 'chr remove_constraint_internal'(A, C),
'detach_target_module/1'(C, A),
'chr_clear/0__4__0'(D, E)
; 'chr_clear/0__4__0'(D, E)
).
'chr_clear/0__4'(A) :-
'chr_clear/0__5'(A).
'chr_clear/0__5'(E) :-
'chr default_store'(A),
get_attr(A, chr_translate_bootstrap1, B),
B=v(C, _, _, _, _, _, D),
C/\32=:=32, !,
'chr_clear/0__5__0'(D, E).
'chr_clear/0__5__0'([], A) :-
'chr_clear/0__6'(A).
'chr_clear/0__5__0'([A|D], E) :-
( A=suspension(_, B, _, _, _, _, _, _),
B=mutable(active)
-> 'chr remove_constraint_internal'(A, C),
'detach_attached/2'(C, A),
'chr_clear/0__5__0'(D, E)
; 'chr_clear/0__5__0'(D, E)
).
'chr_clear/0__5'(A) :-
'chr_clear/0__6'(A).
'chr_clear/0__6'(_) :- !.
Reference in New Issue View Git Blame Copy Permalink