/* Generated by CHR bootstrap compiler From: /opt/logicmoo_workspace/swipl-devel/packages/chr/chr_translate_bootstrap2.chr Date: Fri Sep 15 03:25:25 2023 DO NOT EDIT. EDIT THE CHR FILE INSTEAD */ :- module(chr_translate, [ chr_translate/2 ]). :- use_module(chr(chr_runtime)). :- style_check(- (discontiguous)). :- style_check(-singleton). :- style_check(-no_effect). :- use_module(chr(chr_runtime)). :- use_module(chr(chr_hashtable_store)). :- style_check(- (discontiguous)). :- use_module(library(lists)). :- use_module(library(ordsets)). :- use_module(library(dialect/hprolog)). :- use_module(chr(pairlist)). :- use_module(chr(a_star)). :- use_module(chr(clean_code)). :- use_module(chr(builtins)). :- use_module(chr(find)). :- include(chr(chr_op2)). chr_translate(A, B) :- init_chr_pp_flags, partition_clauses(A, C, D, E), ( C==[] -> insert_declarations(E, B) ; add_rules(D), check_rules(D, C), add_occurrences(D), late_allocation(C), unique_analyse_optimise(D, F), check_attachments(C), assume_constraint_stores(C), set_constraint_indices(C, 1), constraints_code(C, F, G), validate_store_type_assumptions(C), store_management_preds(C, H), insert_declarations(E, I), chr_module_declaration(J), append([I, H, G, J], B) ). store_management_preds(A, B) :- generate_attach_detach_a_constraint_all(A, C), generate_indexed_variables_clauses(A, D), generate_attach_increment(E), generate_attr_unify_hook(F), generate_extra_clauses(A, G), generate_insert_delete_constraints(A, H), generate_store_code(A, I), append([C, D, E, F, G, H, I], B). specific_declarations([(:-use_module(chr(chr_runtime))), (:-use_module(chr(chr_hashtable_store))), (:-style_check(- (discontiguous)))|A], A). insert_declarations(A, B) :- specific_declarations(C, D), ( A=[(:-module(E, F))|G] -> B=[(:-module(E, F))|C], D=G ; B=C, D=A ). chr_module_declaration(A) :- get_target_module(B), ( B\==chr_translate -> A=[(:-multifile chr:'$chr_module'/1), chr:'$chr_module'(B)] ; A=[] ). partition_clauses([], [], [], []). partition_clauses([A|B], C, D, E) :- ( parse_rule(A, F) -> C=G, D=[F|H], E=I ; is_declaration(A, J) -> append(J, G, C), D=H, E=I ; is_module_declaration(A, K) -> target_module(K), C=G, D=H, E=[A|I] ; A=handler(_) -> format('CHR compiler WARNING: ~w.\n', [A]), format(' `--> SICStus compatibility: ignoring handler/1 declaration.\n', []), C=G, D=H, E=I ; A=rules(_) -> format('CHR compiler WARNING: ~w.\n', [A]), format(' `--> SICStus compatibility: ignoring rules/1 declaration.\n', []), C=G, D=H, E=I ; A=(:-chr_option(L, M)) -> handle_option(L, M), C=G, D=H, E=I ; A=(:-chr_type(_)) -> C=G, D=H, E=I ; C=G, D=H, E=[A|I] ), partition_clauses(B, G, H, I). is_declaration(A, B) :- A=(:-C), ( C=..[chr_constraint, D] ; C=..[chr_constraint, D] ), conj2list(D, B). parse_rule(A, B) :- A= @(C, D), !, rule(D, yes(C), B). parse_rule(A, B) :- rule(A, no, B). rule(A, B, C) :- A=pragma(D, E), !, is_rule(D, F, G), conj2list(E, H), inc_rule_count(I), C=pragma(F, G, H, B, I). rule(A, B, C) :- is_rule(A, D, E), inc_rule_count(F), C=pragma(D, E, [], B, F). is_rule(A, B, C) :- A= ==>(D, E), !, conj2list(D, F), get_ids(F, G, H), C=ids([], G), ( E=(I| J) -> B=rule([], H, I, J) ; B=rule([], H, true, E) ). is_rule(A, B, C) :- A= <=>(D, E), !, ( E=(F| G) -> H=F, I=G ; H=true, I=E ), ( D= \(J, K) -> conj2list(J, L), conj2list(K, M), get_ids(L, N, O, 0, P), get_ids(M, Q, R, P, _), C=ids(Q, N) ; conj2list(D, M), O=[], get_ids(M, Q, R), C=ids(Q, []) ), B=rule(R, O, H, I). get_ids(A, B, C) :- get_ids(A, B, C, 0, _). get_ids([], [], [], A, A). get_ids([A|B], [C|D], [E|F], C, G) :- ( A= #(E, C) -> true ; E=A ), H is C+1, get_ids(B, D, F, H, G). is_module_declaration((:-module(A)), A). is_module_declaration((:-module(A, _)), A). add_rules([]). add_rules([A|B]) :- A=pragma(_, _, _, _, C), rule(C, A), add_rules(B). check_rules([], _). check_rules([A|B], C) :- check_rule(A, C), check_rules(B, C). check_rule(A, B) :- check_rule_indexing(A), A=pragma(C, _, D, _, _), C=rule(E, F, _, _), append(E, F, G), check_head_constraints(G, B, A), check_pragmas(D, A). check_head_constraints([], _, _). check_head_constraints([A|B], C, D) :- functor(A, E, F), ( member(E/F, C) -> check_head_constraints(B, C, D) ; format('CHR compiler ERROR: Undeclared constraint ~w in head of ~@.\n', [E/F, format_rule(D)]), format(' `--> Constraint should be one of ~w.\n', [C]), fail ). check_pragmas([], _). check_pragmas([A|B], C) :- check_pragma(A, C), check_pragmas(B, C). check_pragma(A, B) :- var(A), !, format('CHR compiler ERROR: invalid pragma ~w in ~@.\n', [A, format_rule(B)]), format(' `--> Pragma should not be a variable!\n', []), fail. check_pragma(passive(A), B) :- !, B=pragma(_, ids(C, D), _, _, E), ( memberchk_eq(A, C) -> true ; memberchk_eq(A, D) -> true ; format('CHR compiler ERROR: invalid identifier ~w in pragma passive in ~@.\n', [A, format_rule(B)]), fail ), passive(E, A). check_pragma(A, B) :- A=unique(C, D), !, B=pragma(_, _, _, _, E), pragma_unique(E, C, D), format('CHR compiler WARNING: undocumented pragma ~w in ~@.\n', [A, format_rule(B)]), format(' `--> Only use this pragma if you know what you are doing.\n', []). check_pragma(A, B) :- A=already_in_heads, !, format('CHR compiler WARNING: currently unsupported pragma ~w in ~@.\n', [A, format_rule(B)]), format(' `--> Pragma is ignored. Termination and correctness may be affected \n', []). check_pragma(A, B) :- A=already_in_head(_), !, format('CHR compiler WARNING: currently unsupported pragma ~w in ~@.\n', [A, format_rule(B)]), format(' `--> Pragma is ignored. Termination and correctness may be affected \n', []). check_pragma(A, B) :- format('CHR compiler ERROR: invalid pragma ~w in ~@.\n', [A, format_rule(B)]), format(' `--> Pragma should be one of passive/1!\n', []), fail. format_rule(A) :- A=pragma(_, _, _, B, C), ( B=yes(D) -> write('rule '), write(D) ; write('rule number '), write(C) ). check_rule_indexing(A) :- A=pragma(B, _, _, _, _), B=rule(C, D, E, _), term_variables(C-D, F), remove_anti_monotonic_guards(E, F, G), check_indexing(C, G-D), check_indexing(D, G-C). remove_anti_monotonic_guards(A, B, C) :- conj2list(A, D), remove_anti_monotonic_guard_list(D, B, E), list2conj(E, C). remove_anti_monotonic_guard_list([], _, []). remove_anti_monotonic_guard_list([A|B], C, D) :- ( A=var(E), memberchk_eq(E, C) -> D=F ; D=[A|F] ), remove_anti_monotonic_guard_list(B, C, F). check_indexing([], _). check_indexing([A|B], C) :- functor(A, D, E), A=..[_|F], term_variables(B-C, G), check_indexing(F, 1, D/E, G), check_indexing(B, [A|C]). check_indexing([], _, _, _). check_indexing([A|B], C, D, E) :- ( is_indexed_argument(D, C) -> true ; nonvar(A) -> indexed_argument(D, C) ; term_variables(B, F), append(F, E, G), ( memberchk_eq(A, G) -> indexed_argument(D, C) ; true ) ), H is C+1, term_variables(A, I), append(I, E, J), check_indexing(B, H, D, J). add_occurrences([]). add_occurrences([A|B]) :- A=pragma(rule(C, D, _, _), ids(E, F), _, _, G), add_occurrences(C, E, G), add_occurrences(D, F, G), add_occurrences(B). add_occurrences([], [], _). add_occurrences([A|B], [C|D], E) :- functor(A, F, G), H=F/G, get_max_occurrence(H, I), J is I+1, occurrence(H, J, E, C), add_occurrences(B, D, E). late_allocation([]). late_allocation([A|B]) :- allocation_occurrence(A, 1), late_allocation(B). 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(A, B) :- var(B), !, format('CHR compiler ERROR: ~w.\n', [option(A, B)]), 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, B) :- \+ option_definition(A, _, _), !, format('CHR compiler WARNING: ~w.\n', [option(A, B)]), format(' `--> Invalid option name \n', []). handle_option(A, B) :- findall(C, option_definition(A, C, _), D), format('CHR compiler ERROR: ~w.\n', [option(A, B)]), format(' `--> Invalid value ~w: should be one of ~w.\n', [B, 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-off, 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(check_guard_bindings, on, A) :- A=[guard_locks-on]. option_definition(check_guard_bindings, off, A) :- A=[guard_locks-off]. option_definition(reduced_indexing, on, A) :- A=[reduced_indexing-on]. option_definition(reduced_indexing, off, A) :- A=[reduced_indexing-off]. option_definition(mode, A, []) :- ( nonvar(A) -> functor(A, B, C), A=..[_|D], constraint_mode(B/C, D) ; true ). option_definition(store, A-B, []) :- store_type(A, B). option_definition(debug, on, A) :- A=[debugable-on]. option_definition(debug, off, A) :- A=[debugable-off]. option_definition(type_definition, _, []). option_definition(type_declaration, _, []). option_definition(verbosity, _, []). 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, B) :- atom_concat('$chr_pp_', A, C), nb_setval(C, B). 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_definition(reduced_indexing, [on, off]). chr_pp_flag(A, B) :- atom_concat('$chr_pp_', A, C), nb_getval(C, D), ( D==[] -> chr_pp_flag_definition(A, [B|_]) ; D=B ). generate_attach_detach_a_constraint_all([], []). generate_attach_detach_a_constraint_all([A|B], C) :- ( may_trigger(A) -> generate_attach_a_constraint(A, D), generate_detach_a_constraint(A, E) ; D=[], E=[] ), generate_attach_detach_a_constraint_all(B, F), append([D, E, F], C). generate_attach_a_constraint(A, [B, C]) :- generate_attach_a_constraint_empty_list(A, B), get_max_constraint_index(D), ( D==1 -> generate_attach_a_constraint_1_1(A, C) ; generate_attach_a_constraint_t_p(A, C) ). generate_attach_a_constraint_skeleton(A, B, C, D) :- make_name(attach_, A, E), F=..[E|B], D=(F:-C). generate_attach_a_constraint_empty_list(A, B) :- generate_attach_a_constraint_skeleton(A, [[], _], true, B). generate_attach_a_constraint_1_1(A, B) :- C=[[D|E], F], generate_attach_a_constraint_skeleton(A, C, G, B), generate_attach_body_1(A, D, F, H), make_name(attach_, A, I), J=..[I, E, F], G=(H, J). generate_attach_body_1(_, A, B, C) :- get_target_module(D), C=(get_attr(A, D, E)->F=[B|E], put_attr(A, D, F);put_attr(A, D, [B])). generate_attach_a_constraint_t_p(A, B) :- C=[[D|E], F], generate_attach_a_constraint_skeleton(A, C, G, B), make_name(attach_, A, H), I=..[H, E, F], generate_attach_body_n(A, D, F, J), G=(J, I). generate_attach_body_n(A/B, C, D, E) :- get_constraint_index(A/B, F), or_pattern(F, G), get_max_constraint_index(H), make_attr(H, I, J, K), nth1(F, J, L), substitute_eq(L, J, [D|L], M), make_attr(H, I, M, N), substitute_eq(L, J, [D], O), make_attr(H, P, O, Q), copy_term_nat(J, R), nth1(F, R, [D], S), set_elems(S, []), make_attr(H, G, R, T), get_target_module(U), E=(get_attr(C, U, V)->V=K, (I/\G=:=G->put_attr(C, U, N);P is I\/G, put_attr(C, U, Q));put_attr(C, U, T)). generate_detach_a_constraint(A, [B, C]) :- generate_detach_a_constraint_empty_list(A, B), get_max_constraint_index(D), ( D==1 -> generate_detach_a_constraint_1_1(A, C) ; generate_detach_a_constraint_t_p(A, C) ). generate_detach_a_constraint_empty_list(A, B) :- make_name(detach_, A, C), D=[[], _], E=..[C|D], B=(E:-true). generate_detach_a_constraint_1_1(A, B) :- make_name(detach_, A, C), D=[[E|F], G], H=..[C|D], I=..[C, F, G], generate_detach_body_1(A, E, G, J), K=(J, I), B=(H:-K). generate_detach_body_1(_, A, B, C) :- get_target_module(D), C=(get_attr(A, D, E)->'chr sbag_del_element'(E, B, F), (F==[]->del_attr(A, D);put_attr(A, D, F));true). generate_detach_a_constraint_t_p(A, B) :- make_name(detach_, A, C), D=[[E|F], G], H=..[C|D], I=..[C, F, G], generate_detach_body_n(A, E, G, J), K=(J, I), B=(H:-K). generate_detach_body_n(A/B, C, D, E) :- get_constraint_index(A/B, F), or_pattern(F, G), and_pattern(F, H), get_max_constraint_index(I), make_attr(I, J, K, L), nth1(F, K, M), substitute_eq(M, K, [], N), make_attr(I, O, N, P), substitute_eq(M, K, Q, R), make_attr(I, J, R, S), get_target_module(T), E=(get_attr(C, T, U)->U=L, (J/\G=:=G->'chr sbag_del_element'(M, D, Q), (Q==[]->O is J/\H, (O==0->del_attr(C, T);put_attr(C, T, P));put_attr(C, T, S));true);true). generate_indexed_variables_clauses(A, B) :- ( forsome(C, A, chr_translate:may_trigger(C)) -> generate_indexed_variables_clauses_(A, B) ; B=[] ). generate_indexed_variables_clauses_([], []). generate_indexed_variables_clauses_([A|B], C) :- ( ( is_attached(A) ; chr_pp_flag(debugable, on) ) -> C=[D|E], generate_indexed_variables_clause(A, D) ; C=E ), generate_indexed_variables_clauses_(B, E). generate_indexed_variables_clause(A/B, C) :- functor(D, A, B), get_constraint_mode(A/B, E), D=..[_|F], create_indexed_variables_body(F, E, G, 1, A/B, H, I), ( H==empty -> J=(G=[]) ; I==0 -> J=term_variables(K, G) ; H=J ), C=('$indexed_variables'(K, G):-K=D, J). create_indexed_variables_body([], [], _, _, _, empty, 0). create_indexed_variables_body([A|B], [C|D], E, F, G, H, I) :- J is F+1, create_indexed_variables_body(B, D, K, J, G, L, M), ( C\==(+), is_indexed_argument(G, F) -> ( L==empty -> H=term_variables(A, E) ; H=(term_variables(A, E, K), L) ), I=M ; E=K, H=L, I is M+1 ). generate_extra_clauses(A, [B, C, D, E, F]) :- ( chr_pp_flag(reduced_indexing, on) -> global_indexed_variables_clause(A, E) ; E=(chr_indexed_variables(G, H):-'chr chr_indexed_variables'(G, H)) ), generate_remove_clause(B), generate_activate_clause(C), generate_allocate_clause(D), generate_insert_constraint_internal(F). generate_remove_clause(A) :- A=(remove_constraint_internal(B, C, D):-arg(2, B, E), 'chr get_mutable'(F, E), 'chr update_mutable'(removed, E), (compound(F)->C=[], D=no;F==removed->C=[], D=no;D=yes, chr_indexed_variables(B, C))). generate_activate_clause(A) :- A=(activate_constraint(B, C, D, E):-arg(2, D, F), 'chr get_mutable'(G, F), 'chr update_mutable'(active, F), (nonvar(E)->true;arg(4, D, H), 'chr get_mutable'(I, H), E is I+1, 'chr update_mutable'(E, H)), (compound(G)->term_variables(G, C), 'chr none_locked'(C), B=yes;G==removed->chr_indexed_variables(D, C), B=yes;C=[], B=no)). generate_allocate_clause(A) :- A=(allocate_constraint(B, C, D, E):-C=..[suspension, F, G, B, H, I, D|E], 'chr create_mutable'(0, H), 'chr empty_history'(J), 'chr create_mutable'(J, I), chr_indexed_variables(C, K), 'chr create_mutable'(passive(K), G), 'chr gen_id'(F)). generate_insert_constraint_internal(A) :- A=(insert_constraint_internal(yes, B, C, D, E, F):-C=..[suspension, G, H, D, I, J, E|F], chr_indexed_variables(C, B), 'chr none_locked'(B), 'chr create_mutable'(active, H), 'chr create_mutable'(0, I), 'chr empty_history'(K), 'chr create_mutable'(K, J), 'chr gen_id'(G)). global_indexed_variables_clause(A, B) :- ( forsome(C, A, chr_translate:may_trigger(C)) -> D=(E=..[_, _, _, _, _, _, F|_], '$indexed_variables'(F, G)) ; D=true, G=[] ), B=(chr_indexed_variables(E, G):-D). generate_attach_increment(A) :- get_max_constraint_index(B), ( B>0 -> A=[C, D], generate_attach_increment_empty(C), ( B==1 -> generate_attach_increment_one(D) ; generate_attach_increment_many(B, D) ) ; A=[] ). generate_attach_increment_empty((attach_increment([], _):-true)). generate_attach_increment_one(A) :- B=attach_increment([C|D], E), get_target_module(F), G=('chr not_locked'(C), (get_attr(C, F, H)->sort(H, I), merge(E, I, J), put_attr(C, F, J);put_attr(C, F, E)), attach_increment(D, E)), A=(B:-G). generate_attach_increment_many(A, B) :- make_attr(A, C, D, E), make_attr(A, F, G, H), I=attach_increment([J|K], E), bagof(L, M^N^O^P^(member2(D, G, M-N), L=(sort(N, O), 'chr merge_attributes'(M, O, P))), Q), list2conj(Q, R), bagof(S, T^U^V^member((T, 'chr merge_attributes'(U, V, S)), Q), W), make_attr(A, X, W, Y), get_target_module(Z), A1=('chr not_locked'(J), (get_attr(J, Z, B1)->B1=H, R, X is C\/F, put_attr(J, Z, Y);put_attr(J, Z, E)), attach_increment(K, E)), B=(I:-A1). generate_attr_unify_hook([A]) :- get_max_constraint_index(B), ( B==0 -> get_target_module(C), A=(attr_unify_hook(_, _):-write('ERROR: Unexpected triggering of attr_unify_hook/2 in module '), writeln(C)) ; B==1 -> generate_attr_unify_hook_one(A) ; generate_attr_unify_hook_many(B, A) ). generate_attr_unify_hook_one(A) :- B=attr_unify_hook(C, D), get_target_module(E), make_run_suspensions(F, G), make_run_suspensions(C, H), I=(sort(C, J), (var(D)->(get_attr(D, E, K)->true;K=[]), sort(K, L), 'chr merge_attributes'(J, L, F), put_attr(D, E, F), G;(compound(D)->term_variables(D, M), attach_increment(M, J);true), H)), A=(B:-I). generate_attr_unify_hook_many(A, B) :- make_attr(A, C, D, E), make_attr(A, F, G, H), bagof(I, J^K^(member(J, D), I=sort(J, K)), L), list2conj(L, M), bagof(K, J^member(sort(J, K), L), N), bagof(O, P^Q^R^S^(member2(N, G, P-Q), O=(sort(Q, R), 'chr merge_attributes'(P, R, S))), T), bagof(S, P^R^U^member((U, 'chr merge_attributes'(P, R, S)), T), V), list2conj(T, W), make_attr(A, X, V, Y), make_attr(A, C, N, Z), A1=attr_unify_hook(E, B1), get_target_module(C1), make_run_suspensions_loop(V, D1), make_run_suspensions_loop(N, E1), F1=(M, (var(B1)->(get_attr(B1, C1, G1)->G1=H, W, X is C\/F, put_attr(B1, C1, Y), D1;put_attr(B1, C1, Z), E1);(compound(B1)->term_variables(B1, H1), attach_increment(H1, Z);true), E1)), B=(A1:-F1). make_run_suspensions(A, B) :- ( chr_pp_flag(debugable, on) -> B='chr run_suspensions_d'(A) ; B='chr run_suspensions'(A) ). make_run_suspensions_loop(A, B) :- ( chr_pp_flag(debugable, on) -> B='chr run_suspensions_loop_d'(A) ; B='chr run_suspensions_loop'(A) ). generate_insert_delete_constraints([], []). generate_insert_delete_constraints([A|B], C) :- ( is_attached(A) -> C=[D, E|F], generate_insert_delete_constraint(A, D, E) ; C=F ), generate_insert_delete_constraints(B, F). generate_insert_delete_constraint(A, B, C) :- get_store_type(A, D), generate_insert_constraint(D, A, B), generate_delete_constraint(D, A, C). generate_insert_constraint(A, B, C) :- make_name('$insert_in_store_', B, D), E=..[D, F], generate_insert_constraint_body(A, B, F, G), C=(E:-G). generate_insert_constraint_body(default, A, B, C) :- get_target_module(_), get_max_constraint_index(D), ( D==1 -> generate_attach_body_1(A, E, B, F) ; generate_attach_body_n(A, E, B, F) ), C=('chr default_store'(E), F). generate_insert_constraint_body(multi_hash(A), B, C, D) :- generate_multi_hash_insert_constraint_bodies(A, B, C, D). generate_insert_constraint_body(global_ground, A, B, C) :- global_ground_store_name(A, D), make_get_store_goal(D, E, F), make_update_store_goal(D, [B|E], G), C=(F, G). generate_insert_constraint_body(multi_store(A), B, C, D) :- find_with_var_identity(E, [C], (member(F, A), chr_translate:generate_insert_constraint_body(F, B, C, E)), G), list2conj(G, D). generate_multi_hash_insert_constraint_bodies([], _, _, true). generate_multi_hash_insert_constraint_bodies([A|B], C, D, (E, F)) :- multi_hash_store_name(C, A, G), multi_hash_key(C, A, D, H, I), make_get_store_goal(G, J, K), E=(H, K, insert_ht(J, I, D)), generate_multi_hash_insert_constraint_bodies(B, C, D, F). generate_delete_constraint(A, B, C) :- make_name('$delete_from_store_', B, D), E=..[D, F], generate_delete_constraint_body(A, B, F, G), C=(E:-G). generate_delete_constraint_body(default, A, B, C) :- get_target_module(_), get_max_constraint_index(D), ( D==1 -> generate_detach_body_1(A, E, B, F), C=('chr default_store'(E), F) ; generate_detach_body_n(A, E, B, F), C=('chr default_store'(E), F) ). generate_delete_constraint_body(multi_hash(A), B, C, D) :- generate_multi_hash_delete_constraint_bodies(A, B, C, D). generate_delete_constraint_body(global_ground, A, B, C) :- global_ground_store_name(A, D), make_get_store_goal(D, E, F), make_update_store_goal(D, G, H), C=(F, 'chr sbag_del_element'(E, B, G), H). generate_delete_constraint_body(multi_store(A), B, C, D) :- find_with_var_identity(E, [C], (member(F, A), chr_translate:generate_delete_constraint_body(F, B, C, E)), G), list2conj(G, D). generate_multi_hash_delete_constraint_bodies([], _, _, true). generate_multi_hash_delete_constraint_bodies([A|B], C, D, (E, F)) :- multi_hash_store_name(C, A, G), multi_hash_key(C, A, D, H, I), make_get_store_goal(G, J, K), E=(H, K, delete_ht(J, I, D)), generate_multi_hash_delete_constraint_bodies(B, C, D, F). generate_delete_constraint_call(A, B, C) :- make_name('$delete_from_store_', A, D), C=..[D, B]. generate_insert_constraint_call(A, B, C) :- make_name('$insert_in_store_', A, D), C=..[D, B]. generate_store_code(A, [B|C]) :- enumerate_stores_code(A, B), generate_store_code(A, C, []). generate_store_code([], A, A). generate_store_code([A|B], C, D) :- get_store_type(A, E), generate_store_code(E, A, C, F), generate_store_code(B, F, D). generate_store_code(default, _, A, A). generate_store_code(multi_hash(A), B, C, D) :- multi_hash_store_initialisations(A, B, C, E), multi_hash_via_lookups(A, B, E, D). generate_store_code(global_ground, A, B, C) :- global_ground_store_initialisation(A, B, C). generate_store_code(multi_store(A), B, C, D) :- multi_store_generate_store_code(A, B, C, D). multi_store_generate_store_code([], _, A, A). multi_store_generate_store_code([A|B], C, D, E) :- generate_store_code(A, C, D, F), multi_store_generate_store_code(B, C, F, E). multi_hash_store_initialisations([], _, A, A). multi_hash_store_initialisations([A|B], C, D, E) :- multi_hash_store_name(C, A, F), make_init_store_goal(F, G, H), D=[(:-new_ht(G), H)|I], multi_hash_store_initialisations(B, C, I, E). global_ground_store_initialisation(A, B, C) :- global_ground_store_name(A, D), make_init_store_goal(D, [], E), B=[(:-E)|C]. multi_hash_via_lookups([], _, A, A). multi_hash_via_lookups([A|B], C, D, E) :- multi_hash_via_lookup_name(C, A, F), G=..[F, H, I], multi_hash_store_name(C, A, J), make_get_store_goal(J, K, L), M=(L, lookup_ht(K, H, I)), D=[(G:-M)|N], multi_hash_via_lookups(B, C, N, E). multi_hash_via_lookup_name(A/B, C, D) :- ( integer(C) -> E=C ; is_list(C) -> atom_concat_list(C, E) ), atom_concat_list(['$via1_multi_hash_', A, /, B, -, E], D). multi_hash_store_name(A/B, C, D) :- get_target_module(E), ( integer(C) -> F=C ; is_list(C) -> atom_concat_list(C, F) ), atom_concat_list([ '$chr_store_multi_hash_', E, :, A, /, B, -, F ], D). multi_hash_key(_/_, A, B, C, D) :- ( ( integer(A) -> E=A ; A=[E] ) -> F is E+6, C=arg(F, B, D) ; is_list(A) -> sort(A, G), find_with_var_identity(arg(H, B, I)-I, [B], (member(E, G), H is E+6), J), pairup(K, L, J), D=..[k|L], list2conj(K, C) ). multi_hash_key_args(A, B, C) :- ( integer(A) -> arg(A, B, D), C=[D] ; is_list(A) -> sort(A, E), term_variables(B, F), find_with_var_identity(D, F, (member(G, E), arg(G, B, D)), C) ). global_ground_store_name(A/B, C) :- get_target_module(D), atom_concat_list(['$chr_store_global_ground_', D, :, A, /, B], C). enumerate_stores_code(A, B) :- C='$enumerate_suspensions'(D), enumerate_store_bodies(A, D, E), list2disj(E, F), B=(C:-F). enumerate_store_bodies([], _, []). enumerate_store_bodies([A|B], C, D) :- ( is_attached(A) -> get_store_type(A, E), enumerate_store_body(E, A, C, F), D=[F|G] ; D=G ), enumerate_store_bodies(B, C, G). enumerate_store_body(default, A, B, C) :- get_constraint_index(A, D), get_target_module(E), get_max_constraint_index(F), G=('chr default_store'(H), get_attr(H, E, I)), ( F>1 -> J is D+1, K=(arg(J, I, L), member(B, L)) ; K=member(B, I) ), C=(G, K). enumerate_store_body(multi_hash([A|_]), B, C, D) :- multi_hash_enumerate_store_body(A, B, C, D). enumerate_store_body(global_ground, A, B, C) :- global_ground_store_name(A, D), make_get_store_goal(D, E, F), C=(F, member(B, E)). enumerate_store_body(multi_store(A), B, C, D) :- once(( member(E, A), enumerate_store_body(E, B, C, D) )). multi_hash_enumerate_store_body(A, B, C, D) :- multi_hash_store_name(B, A, E), make_get_store_goal(E, F, G), D=(G, value_ht(F, C)). check_attachments(A) :- ( chr_pp_flag(check_attachments, on) -> check_constraint_attachments(A) ; true ). check_constraint_attachments([]). check_constraint_attachments([A|B]) :- check_constraint_attachment(A), check_constraint_attachments(B). check_constraint_attachment(A) :- get_max_occurrence(A, B), check_occurrences_attachment(A, 1, B). check_occurrences_attachment(A, B, C) :- ( B>C -> true ; check_occurrence_attachment(A, B), D is B+1, check_occurrences_attachment(A, D, C) ). check_occurrence_attachment(A, B) :- get_occurrence(A, B, C, D), get_rule(C, E), E=pragma(rule(F, G, H, I), ids(J, K), _, _, _), ( select2(D, L, J, F, _, _) -> check_attachment_head1(L, D, C, F, G, H) ; select2(D, M, K, G, _, _) -> check_attachment_head2(M, D, C, F, I) ). check_attachment_head1(A, B, C, D, E, F) :- functor(A, G, H), ( D==[A], E==[], F==true, A=..[_|I], no_matching(I, []), \+ is_passive(C, B) -> attached(G/H, no) ; attached(G/H, maybe) ). no_matching([], _). no_matching([A|B], C) :- var(A), \+ memberchk_eq(A, C), no_matching(B, [A|C]). check_attachment_head2(A, B, C, D, E) :- functor(A, F, G), ( is_passive(C, B) -> attached(F/G, maybe) ; D\==[], E==true -> attached(F/G, maybe) ; attached(F/G, yes) ). all_attached([]). all_attached([A|B]) :- functor(A, C, D), is_attached(C/D), all_attached(B). set_constraint_indices([], A) :- B is A-1, max_constraint_index(B). set_constraint_indices([A|B], C) :- ( ( may_trigger(A) ; is_attached(A), get_store_type(A, default) ) -> constraint_index(A, C), D is C+1, set_constraint_indices(B, D) ; set_constraint_indices(B, C) ). constraints_code(A, B, C) :- post_constraints(A, 1), constraints_code1(1, B, D, []), clean_clauses(D, C). post_constraints([], A) :- B is A-1, constraint_count(B). post_constraints([A/B|C], D) :- constraint(A/B, D), E is D+1, post_constraints(C, E). constraints_code1(A, B, C, D) :- get_constraint_count(E), ( A>E -> D=C ; constraint_code(A, B, C, F), G is A+1, constraints_code1(G, B, F, D) ). constraint_code(A, B, C, D) :- get_constraint(E, A), constraint_prelude(E, F), C=[F|G], H=[0], rules_code(B, A, H, I, G, J), gen_cond_attach_clause(E, I, J, D). constraint_prelude(A/B, C) :- vars_susp(B, D, E, F), G=..[A|D], build_head(A, B, [0], F, H), get_target_module(I), J=..[A|D], ( chr_pp_flag(debugable, on) -> C=(G:-allocate_constraint(I:H, E, J, D), ('chr debug_event'(call(E)), H;'chr debug_event'(fail(E)), !, fail), ('chr debug_event'(exit(E));'chr debug_event'(redo(E)), fail)) ; C=(G:-H) ). gen_cond_attach_clause(A/B, C, D, E) :- ( is_attached(A/B) -> ( C==[0] -> ( may_trigger(A/B) -> gen_cond_attach_goal(A/B, F, G, H, I) ; gen_insert_constraint_internal_goal(A/B, F, G, H, I) ) ; vars_susp(B, H, I, G), gen_uncond_attach_goal(A/B, I, F, _) ), ( chr_pp_flag(debugable, on) -> J=..[A|H], K='chr debug_event'(insert(#(J, I))) ; K=true ), build_head(A, B, C, G, L), M=(L:-K, F), D=[M|E] ; D=E ). gen_cond_attach_goal(A/B, C, D, E, F) :- vars_susp(B, E, F, D), build_head(A, B, [0], D, G), ( may_trigger(A/B) -> make_name(attach_, A/B, H), I=..[H, J, F] ; I=true ), get_target_module(K), L=..[A|E], generate_insert_constraint_call(A/B, F, M), C=((var(F)->insert_constraint_internal(N, J, F, K:G, L, E);activate_constraint(N, J, F, _)), (N==yes->M, I;true)). gen_insert_constraint_internal_goal(A/B, C, D, E, F) :- vars_susp(B, E, F, D), build_head(A, B, [0], D, G), ( may_trigger(A/B) -> make_name(attach_, A/B, H), I=..[H, J, F] ; I=true ), get_target_module(K), L=..[A|E], generate_insert_constraint_call(A/B, F, M), C=(insert_constraint_internal(_, J, F, K:G, L, E), M, I). gen_uncond_attach_goal(A, B, C, D) :- ( may_trigger(A) -> make_name(attach_, A, E), F=..[E, G, B] ; F=true ), generate_insert_constraint_call(A, B, H), C=(activate_constraint(I, G, B, D), (I==yes->H, F;true)). rules_code([], _, A, A, B, B). rules_code([A|B], C, D, E, F, G) :- rule_code(A, C, D, H, F, I), rules_code(B, C, H, E, I, G). rule_code(A, B, C, D, E, F) :- A=pragma(G, H, _, _, _), H=ids(I, J), G=rule(K, L, _, _), heads1_code(K, [], I, [], A, B, C, E, M), heads2_code(L, [], J, [], A, B, C, D, M, F). heads1_code([], _, _, _, _, _, _, A, A). heads1_code([A|B], C, [D|E], F, G, H, I, J, K) :- G=pragma(L, _, _, _, M), get_constraint(N/O, H), ( functor(A, N, O), \+ is_passive(M, D), \+ check_unnecessary_active(A, C, L), all_attached(B), all_attached(C), L=rule(_, P, _, _), all_attached(P) -> append(B, C, Q), append(E, F, R), head1_code(A, Q, R, G, N/O, H, I, J, S) ; J=S ), heads1_code(B, [A|C], E, [D|F], G, H, I, S, K). head1_code(A, B, C, D, E, _, F, G, H) :- D=pragma(I, _, _, _, J), I=rule(_, K, _, _), ( K==[] -> reorder_heads(J, A, B, C, L, M), simplification_code(A, L, M, D, E, F, G, H) ; simpagation_head1_code(A, B, C, D, E, F, G, H) ). heads2_code([], _, _, _, _, _, A, A, B, B). heads2_code([A|B], C, [D|E], F, G, H, I, J, K, L) :- G=pragma(M, _, _, _, N), get_constraint(O/P, H), ( functor(A, O, P), \+ is_passive(N, D), \+ check_unnecessary_active(A, C, M), \+ set_semantics_rule(G), all_attached(B), all_attached(C), M=rule(Q, _, _, _), all_attached(Q) -> append(B, C, R), append(E, F, S), length(B, T), head2_code(A, R, S, G, T, O/P, I, K, U), inc_id(I, V), gen_alloc_inc_clause(O/P, I, U, W) ; K=W, V=I ), heads2_code(B, [A|C], E, [D|F], G, H, V, J, W, L). head2_code(A, B, C, D, E, F, G, H, I) :- D=pragma(J, _, _, _, K), J=rule(L, _, _, _), ( L==[] -> reorder_heads(K, A, B, C, M, _), propagation_code(A, M, J, K, E, F, G, H, I) ; simpagation_head2_code(A, B, C, D, F, G, H, I) ). gen_alloc_inc_clause(A/B, C, D, E) :- vars_susp(B, F, G, H), build_head(A, B, C, H, I), inc_id(C, J), build_head(A, B, J, H, K), gen_allocation(C, F, G, A/B, H, L), M=(I:-L, K), D=[M|E]. gen_cond_allocation(A, B, C, D, E) :- gen_allocation(A, B, C, D, F), E=(var(B)->F;true). gen_allocation(A, B, C/D, E, F) :- build_head(C, D, [0], E, G), get_target_module(H), I=..[C|A], F=allocate_constraint(H:G, B, I, A). gen_allocation(A, B, C, D, E, F) :- ( A==[0] -> ( is_attached(D) -> ( may_trigger(D) -> gen_cond_allocation(B, C, D, E, F) ; gen_allocation(B, C, D, E, F) ) ; F=true ) ; F=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(A, B, C, D) :- initialize_unit_dictionary(C, E), build_units(A, B, E, F), dependency_reorder(F, G), units2goal(G, D). 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|B], C, D) :- A=unit(_, _, E, F), ( E==fixed -> G=[A|C] ; dependency_insert(C, A, F, G) ), dependency_reorder(B, G, D). dependency_insert([], A, _, [A]). dependency_insert([A|B], C, D, E) :- A=unit(F, _, _, _), ( memberchk(F, D) -> E=[C, A|B] ; E=[A|G], dependency_insert(B, C, D, G) ). build_units(A, B, C, D) :- build_retrieval_units(A, 1, E, C, F, D, G), build_guard_units(B, E, F, G). build_retrieval_units([], A, A, B, B, C, C). build_retrieval_units([A|B], C, D, E, F, G, H) :- term_variables(A, I), update_unit_dictionary(I, C, E, J, [], K), G=[unit(C, A, movable, K)|L], M is C+1, build_retrieval_units2(B, M, D, J, F, L, H). build_retrieval_units2([], A, A, B, B, C, C). build_retrieval_units2([A|B], C, D, E, F, G, H) :- term_variables(A, I), update_unit_dictionary(I, C, E, J, [], K), G=[unit(C, A, fixed, K)|L], M is C+1, build_retrieval_units(B, M, D, J, F, L, H). initialize_unit_dictionary(A, B) :- term_variables(A, C), pair_all_with(C, 0, B). update_unit_dictionary([], _, A, A, B, B). update_unit_dictionary([A|B], C, D, E, F, G) :- ( lookup_eq(D, A, H) -> ( ( H==C ; memberchk(H, F) ) -> I=F ; I=[H|F] ), J=D ; J=[A-C|D], I=F ), update_unit_dictionary(B, C, J, E, I, G). build_guard_units(A, B, C, D) :- ( A=[E] -> D=[unit(B, E, fixed, [])] ; A=[E|F] -> term_variables(E, G), update_unit_dictionary2(G, B, C, H, [], I), D=[unit(B, E, movable, I)|J], K is B+1, build_guard_units(F, K, H, J) ). update_unit_dictionary2([], _, A, A, B, B). update_unit_dictionary2([A|B], C, D, E, F, G) :- ( lookup_eq(D, A, H) -> ( ( H==C ; memberchk(H, F) ) -> I=F ; I=[H|F] ), J=[A-C|D] ; J=[A-C|D], I=F ), update_unit_dictionary2(B, C, J, E, I, G). 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|B], C, D, [E|F]) :- ( discover_unique_pattern(A, C, G) -> H=[G|D] ; H=D ), A=pragma(I, J, K, L, M), I=rule(N, O, _, _), J=ids(P, Q), apply_unique_patterns_to_constraints(N, P, H, R), apply_unique_patterns_to_constraints(O, Q, H, S), globalize_unique_pragmas(R, M), globalize_unique_pragmas(S, M), append([R, S, K], T), E=pragma(I, J, T, L, M), U is C+1, unique_analyse_optimise_main(B, U, H, F). globalize_unique_pragmas([], _). globalize_unique_pragmas([unique(A, B)|C], D) :- pragma_unique(D, A, B), globalize_unique_pragmas(C, D). apply_unique_patterns_to_constraints([], _, _, []). apply_unique_patterns_to_constraints([A|B], [C|D], E, F) :- ( member(G, E), apply_unique_pattern(A, C, G, H) -> F=[H|I] ; F=I ), apply_unique_patterns_to_constraints(B, D, E, I). apply_unique_pattern(A, B, C, D) :- C=unique(E, F), subsumes(A, E, G), find_with_var_identity(H, G, (member(I, F), lookup_eq(G, I, J), term_variables(J, K), member(H, K)), L), sort(L, M), N=M, D=unique(B, N). subsumes(A, B, C) :- empty_ds(D), subsumes_aux(A, B, D, E), ds_to_list(E, F), build_unifier(F, C). subsumes_aux(A, B, C, D) :- ( compound(B), functor(B, E, F) -> compound(A), functor(A, E, F), subsumes_aux(F, A, B, C, D) ; A==B -> D=C ; var(B), get_ds(A, C, G) -> G==B, D=C ; var(B), put_ds(A, C, B, D) ). subsumes_aux(0, _, _, A, A) :- !. subsumes_aux(A, B, C, D, E) :- arg(A, B, F), arg(A, C, G), subsumes_aux(F, G, D, H), I is A-1, subsumes_aux(I, B, C, H, E). build_unifier([], []). build_unifier([A-B|C], [B-A|D]) :- build_unifier(C, D). discover_unique_pattern(A, B, C) :- A=pragma(D, _, _, E, B), D=rule(F, G, H, _), ( F=[I], G=[J] -> true ; F=[I, J], G==[] -> true ), check_unique_constraints(I, J, H, B, K), term_variables(I, L), select_pragma_unique_variables(K, L, M), N=unique(I, M), copy_term_nat(N, C), ( verbosity_on -> format('Found unique pattern ~w in rule ~d~@\n', [ C, B, (E=yes(O)->write(": "), write(O);true) ]) ; true ). select_pragma_unique_variables([], _, []). select_pragma_unique_variables([A-B|C], D, E) :- ( A==B -> E=[A|F] ; once(( \+ memberchk_eq(A, D) ; \+ memberchk_eq(B, D) )), E=F ), select_pragma_unique_variables(C, D, F). check_unique_constraints(A, B, C, D, E) :- \+ any_passive_head(D), variable_replacement(A-B, B-A, E), copy_with_variable_replacement(C, F, E), negate_b(C, G), once(entails_b(G, F)). 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(A, B, C) :- member(D, B), variable_replacement(D, A, E), copy_with_variable_replacement(C, F, E), identical_rules(C, 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, D, _, E), B=rule([_], [_], true, _), C=ids([F], [G]), once(member(unique(F, H), D)), once(member(unique(G, I), D)), H==I, \+ is_passive(E, F). identical_rules(rule(A, B, C, D), rule(E, F, G, H)) :- C==G, identical_bodies(D, H), permutation(A, I), I==E, permutation(B, J), J==F. identical_bodies(A, B) :- ( A=(C=D), B=(E=F) -> ( C==E, D==F ; C==F, E==D ), ! ; A==B ). copy_with_variable_replacement(A, B, C) :- ( var(A) -> ( lookup_eq(C, A, B) -> true ; A=B ) ; functor(A, D, E), functor(B, D, E), A=..[_|F], B=..[_|G], copy_with_variable_replacement_l(F, G, C) ). copy_with_variable_replacement_l([], [], _). copy_with_variable_replacement_l([A|B], [C|D], E) :- copy_with_variable_replacement(A, C, E), copy_with_variable_replacement_l(B, D, E). variable_replacement(A, B, C) :- variable_replacement(A, B, [], C). variable_replacement(A, B, C, D) :- ( var(A) -> var(B), ( lookup_eq(C, A, E) -> E==B, D=C ; D=[A-B|C] ) ; A=..[F|G], nonvar(B), B=..[F|H], variable_replacement_l(G, H, C, D) ). variable_replacement_l([], [], A, A). variable_replacement_l([A|B], [C|D], E, F) :- variable_replacement(A, C, E, G), variable_replacement_l(B, D, G, F). simplification_code(A, B, C, D, E/F, G, H, I) :- D=pragma(J, _, K, _, _), head_info(A, F, _, L, M, N), build_head(E, F, G, M, O), head_arg_matches(N, [], P, Q), ( B==[] -> R=[], S=Q, T=[] ; rest_heads_retrieval_and_matching(B, C, K, A, T, R, Q, S) ), guard_body_copies2(J, S, U, V), guard_via_reschedule(T, U, O-P, W), gen_uncond_susps_detachments(R, B, X), gen_cond_susp_detachment(G, L, E/F, Y), ( chr_pp_flag(debugable, on) -> J=rule(_, _, Z, A1), my_term_copy(Z-A1, S, _, B1-C1), D1='chr debug_event'(try([L|E1], [], B1, C1)), F1='chr debug_event'(apply([L|E1], [], B1, C1)) ; D1=true, F1=true ), G1=(O:-P, W, D1, !, F1, X, Y, V), H=[G1|I]. head_arg_matches(A, B, C, D) :- head_arg_matches_(A, B, E, D), list2conj(E, C). head_arg_matches_([], A, [], A). head_arg_matches_([A-B|C], D, E, F) :- ( var(A) -> ( lookup_eq(D, A, G) -> E=[B==G|H], I=D ; I=[A-B|D], E=H ), J=C ; atomic(A) -> E=[B==A|H], D=I, J=C ; A=..[_|K], functor(A, L, M), functor(N, L, M), N=..[_|O], E=[nonvar(B), B=N|H], pairup(K, O, P), append(P, C, J), I=D ), head_arg_matches_(J, I, H, F). 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, D, E, F, G, H, I, J, K) :- ( A=[_|_] -> rest_heads_retrieval_and_matching_n(A, B, C, I, J, D, E, F, G, H, K) ; E=[], F=[], G=H ). rest_heads_retrieval_and_matching_n([], _, _, _, _, _, [], [], A, A, B) :- instantiate_pattern_goals(B). rest_heads_retrieval_and_matching_n([A|B], [C|D], E, F, G, H, [I, J|K], [L|M], N, O, P) :- functor(A, Q, R), get_store_type(Q/R, S), ( S==default -> passive_head_via(A, [H|F], P, N, I, T, U), get_max_constraint_index(V), ( V==1 -> W=T ; get_constraint_index(Q/R, X), make_attr(V, _, Y, T), nth1(X, Y, W) ) ; lookup_passive_head(S, A, [H|F], N, I, W), U=P ), head_info(A, R, Z, _, _, A1), head_arg_matches(A1, N, B1, C1), D1=..[suspension, _, E1, _, _, _, _|Z], different_from_other_susps(A, L, F, G, F1), create_get_mutable_ref(active, E1, G1), H1=(member(L, W), L=D1, G1, F1, B1), ( member(unique(C, I1), E), check_unique_keys(I1, N) -> J=(H1->true) ; J=H1 ), rest_heads_retrieval_and_matching_n(B, D, E, [A|F], [L|G], H, K, M, C1, O, U). instantiate_pattern_goals([]). instantiate_pattern_goals([_-attr(A, B, C)|D]) :- get_max_constraint_index(E), ( E==1 -> C=true ; make_attr(E, F, _, A), or_list(B, G), !, C=(F/\G=:=G) ), instantiate_pattern_goals(D). check_unique_keys([], _). check_unique_keys([A|B], C) :- lookup_eq(C, A, _), check_unique_keys(B, C). different_from_other_susps(A, B, C, D, E) :- ( bagof(F, G^(nth1(G, C, H), \+A\=H, nth1(G, D, I), F=(B\==I)), J) -> list2conj(J, E) ; E=true ). passive_head_via(A, B, C, D, E, F, G) :- functor(A, H, I), get_constraint_index(H/I, J), common_variables(A, B, K), translate(K, D, L), or_pattern(J, M), ( permutation(L, N), lookup_eq(C, N, attr(F, O, _)) -> member(M, O), !, G=C, E=true ; E=(P, Q), gen_get_mod_constraints(L, P, F), G=[L-attr(F, [M|_], Q)|C] ). common_variables(A, B, C) :- term_variables(A, D), term_variables(B, E), intersect_eq(D, E, C). gen_get_mod_constraints(A, B, C) :- get_target_module(D), ( A==[] -> B=('chr default_store'(E), get_attr(E, D, F), F=C) ; ( A=[G] -> H='chr via_1'(G, I) ; A=[G, J] -> H='chr via_2'(G, J, I) ; H='chr via'(A, I) ), B=(H, get_attr(I, D, F), F=C) ). guard_body_copies(A, B, C, D) :- guard_body_copies2(A, B, E, D), list2conj(E, C). guard_body_copies2(A, B, C, D) :- A=rule(_, _, E, F), conj2list(E, G), split_off_simple_guard(G, B, H, I), my_term_copy(H-I, B, J, K-L), append(K, [M], C), term_variables(I, N), term_variables(L, O), ( chr_pp_flag(guard_locks, on), find_with_var_identity('chr lock'(P)-'chr unlock'(P), B, (member(Q, N), lookup_eq(B, Q, P), memberchk_eq(P, O)), R) -> once(pairup(S, T, R)) ; S=[], T=[] ), list2conj(S, U), list2conj(T, V), list2conj(L, W), M=(U, W, V), my_term_copy(F, J, D). split_off_simple_guard([], _, [], []). split_off_simple_guard([A|B], C, D, E) :- ( simple_guard(A, C) -> D=[A|F], split_off_simple_guard(B, C, F, E) ; D=[], E=[A|B] ). simple_guard(A, B) :- binds_b(A, C), not(( member(D, C), lookup_eq(B, D, _) )). my_term_copy(A, B, C) :- my_term_copy(A, B, _, C). my_term_copy(A, B, C, D) :- ( var(A) -> ( lookup_eq(B, A, D) -> C=B ; C=[A-D|B] ) ; functor(A, E, F), functor(D, E, F), A=..[_|G], D=..[_|H], my_term_copy_list(G, B, C, H) ). my_term_copy_list([], A, A, []). my_term_copy_list([A|B], C, D, [E|F]) :- my_term_copy(A, C, G, E), my_term_copy_list(B, G, D, F). gen_cond_susp_detachment(A, B, C, D) :- ( is_attached(C) -> ( A==[0], \+ may_trigger(C) -> D=true ; gen_uncond_susp_detachment(B, C, E), D=(var(B)->true;E) ) ; D=true ). gen_uncond_susp_detachment(A, B, C) :- ( is_attached(B) -> ( may_trigger(B) -> make_name(detach_, B, D), E=..[D, F, A] ; E=true ), ( chr_pp_flag(debugable, on) -> G='chr debug_event'(remove(A)) ; G=true ), generate_delete_constraint_call(B, A, H), C=(G, remove_constraint_internal(A, F, I), (I==yes->H, E;true)) ; C=true ). gen_uncond_susps_detachments([], [], true). gen_uncond_susps_detachments([A|B], [C|D], (E, F)) :- functor(C, G, H), gen_uncond_susp_detachment(A, G/H, E), gen_uncond_susps_detachments(B, D, F). simpagation_head1_code(A, B, C, D, E/F, G, H, I) :- D=pragma(J, ids(_, K), L, _, M), J=rule(_, N, O, P), head_info(A, F, _, Q, R, S), head_arg_matches(S, [], T, U), build_head(E, F, G, R, V), append(B, N, W), append(C, K, X), reorder_heads(M, A, W, X, Y, Z), rest_heads_retrieval_and_matching(Y, Z, L, A, A1, B1, U, C1), split_by_ids(Z, B1, C, D1, E1), guard_body_copies2(J, C1, F1, G1), guard_via_reschedule(A1, F1, V-T, H1), gen_uncond_susps_detachments(D1, B, I1), gen_cond_susp_detachment(G, Q, E/F, J1), ( chr_pp_flag(debugable, on) -> my_term_copy(O-P, C1, _, K1-L1), M1='chr debug_event'(try([Q|D1], E1, K1, L1)), N1='chr debug_event'(apply([Q|D1], E1, K1, L1)) ; M1=true, N1=true ), O1=(V:-T, H1, M1, !, N1, I1, J1, G1), H=[O1|I]. split_by_ids([], [], _, [], []). split_by_ids([A|B], [C|D], E, F, G) :- ( memberchk_eq(A, E) -> F=[C|H], G=I ; F=H, G=[C|I] ), split_by_ids(B, D, E, H, I). simpagation_head2_code(A, B, C, D, E, F, G, H) :- D=pragma(I, ids(J, _), _, _, K), I=rule(L, _, M, N), reorder_heads(K, A, L, J, [O|P], [Q|R]), simpagation_head2_prelude(A, O, [B, L, M, N], E, F, G, S), extend_id(F, T), simpagation_head2_worker(A, O, Q, P, R, B, C, D, E, T, S, H). simpagation_head2_prelude(A, B, C, D/E, F, G, H) :- head_info(A, E, I, J, K, L), build_head(D, E, F, K, M), head_arg_matches(L, [], N, O), lookup_passive_head(B, [A], O, P, Q), gen_allocation(F, I, J, D/E, K, R), extend_id(F, S), extra_active_delegate_variables(A, C, O, T), append([Q|K], T, U), build_head(D, E, S, U, V), W=(M:-N, P, !, R, V), G=[W|H]. extra_active_delegate_variables(A, B, C, D) :- A=..[_|E], delegate_variables(A, B, C, E, D). passive_delegate_variables(A, B, C, D, E) :- term_variables(B, F), delegate_variables(A, C, D, F, E). delegate_variables(A, B, C, D, E) :- term_variables(A, F), term_variables(B, G), intersect_eq(F, G, H), list_difference_eq(H, D, I), translate(I, C, E). simpagation_head2_worker(A, B, C, D, E, F, G, H, I, J, K, L) :- H=pragma(M, _, _, _, _), M=rule(_, _, N, O), simpagation_head2_worker_end(A, [B, D, F, N, O], I, J, K, P), simpagation_head2_worker_body(A, B, C, D, E, F, G, H, I, J, P, L). simpagation_head2_worker_body(A, B, C, D, E, F, G, H, I/J, K, L, M) :- gen_var(N), gen_var(O), head_info(A, J, _, P, Q, R), head_arg_matches(R, [], _, S), H=pragma(T, _, U, _, V), T=rule(_, _, W, X), extra_active_delegate_variables(A, [ B, D, F, W, X ], S, Y), append([[N|O]|Q], Y, Z), build_head(I, J, K, Z, A1), functor(B, _, B1), head_info(B, B1, C1, _, _, D1), head_arg_matches(D1, S, E1, F1), G1=..[suspension, _, H1, _, _, _, _|C1], create_get_mutable_ref(active, H1, I1), J1=(N=G1, I1), ( ( D\==[] ; F\==[] ) -> append(D, F, K1), append(E, G, L1), reorder_heads(V, B-A, K1, L1, M1, N1), rest_heads_retrieval_and_matching(M1, N1, U, [B, A], O1, P1, F1, Q1, [B], [N], []), split_by_ids(N1, P1, E, R1, S1) ; O1=[], R1=[], S1=[], Q1=F1 ), gen_uncond_susps_detachments([N|R1], [B|D], T1), append([O|Q], Y, U1), build_head(I, J, K, U1, V1), append([[]|Q], Y, W1), build_head(I, J, K, W1, X1), guard_body_copies2(T, Q1, Y1, Z1), guard_via_reschedule(O1, Y1, v(A1, J1, E1), A2), ( Z1\==true -> gen_uncond_attach_goal(I/J, P, B2, C2), gen_state_cond_call(P, J, V1, C2, D2), gen_state_cond_call(P, J, X1, C2, E2) ; B2=true, D2=V1, E2=X1 ), ( chr_pp_flag(debugable, on) -> my_term_copy(W-X, Q1, _, F2-G2), H2='chr debug_event'(try([N|R1], [P|S1], F2, G2)), I2='chr debug_event'(apply([N|R1], [P|S1], F2, G2)) ; H2=true, I2=true ), ( member(unique(C, J2), U), check_unique_keys(J2, S) -> K2=(A1:-J1, E1->(A2, H2->I2, T1, B2, Z1, E2;X1);V1) ; K2=(A1:-J1, E1, A2, H2->I2, T1, B2, Z1, D2;V1) ), L=[K2|M]. gen_state_cond_call(A, B, C, D, E) :- length(F, B), G=..[suspension, _, H, _, I, _, _|F], create_get_mutable_ref(active, H, J), create_get_mutable_ref(D, I, K), E=(A=G, J, K->'chr update_mutable'(inactive, H), C;true). simpagation_head2_worker_end(A, B, C/D, E, F, G) :- head_info(A, D, _, _, H, I), head_arg_matches(I, [], _, J), extra_active_delegate_variables(A, B, J, K), append([[]|H], K, L), build_head(C, D, E, L, M), next_id(E, N), build_head(C, D, N, H, O), P=(M:-O), F=[P|G]. propagation_code(A, B, C, D, E, F, G, H, I) :- ( B==[] -> propagation_single_headed(A, C, D, F, G, H, I) ; propagation_multi_headed(A, B, C, D, E, F, G, H, I) ). propagation_single_headed(A, B, C, D/E, F, G, H) :- head_info(A, E, I, J, K, L), build_head(D, E, F, K, M), inc_id(F, N), build_head(D, E, N, K, O), P=O, head_arg_matches(L, [], Q, R), guard_body_copies(B, R, S, T), gen_allocation(F, I, J, D/E, K, U), gen_uncond_attach_goal(D/E, J, V, W), gen_state_cond_call(J, E, P, W, X), ( chr_pp_flag(debugable, on) -> B=rule(_, _, Y, Z), my_term_copy(Y-Z, R, _, A1-B1), C1='chr debug_event'(try([], [J], A1, B1)), D1='chr debug_event'(apply([], [J], A1, B1)) ; C1=true, D1=true ), E1=(M:-Q, U, 'chr novel_production'(J, C), S, C1, !, D1, 'chr extend_history'(J, C), V, T, X), G=[E1|H]. propagation_multi_headed(A, B, C, D, E, F, G, H, I) :- B=[J|K], propagation_prelude(A, B, C, F, G, H, L), extend_id(G, M), propagation_nested_code(K, [J, A], C, D, E, F, M, L, I). propagation_prelude(A, [B|C], D, E/F, G, H, I) :- head_info(A, F, J, K, L, M), build_head(E, F, G, L, N), head_arg_matches(M, [], O, P), D=rule(_, _, Q, R), extra_active_delegate_variables(A, [B, C, Q, R], P, S), lookup_passive_head(B, [A], P, T, U), gen_allocation(G, J, K, E/F, L, V), extend_id(G, W), append([U|L], S, X), build_head(E, F, W, X, Y), Z=Y, A1=(N:-O, T, !, V, Z), H=[A1|I]. propagation_nested_code([], [A|B], C, D, E, F, G, H, I) :- propagation_end([A|B], [], C, F, G, H, J), propagation_body(A, B, C, D, E, F, G, J, I). propagation_nested_code([A|B], C, D, E, F, G, H, I, J) :- propagation_end(C, [A|B], D, G, H, I, K), propagation_accumulator([A|B], C, D, G, H, K, L), inc_id(H, M), propagation_nested_code(B, [A|C], D, E, F, G, M, L, J). propagation_body(A, B, C, D, E, F/G, H, I, J) :- C=rule(_, _, K, L), get_prop_inner_loop_vars(B, [A, K, L], M, N, O, P), gen_var(Q), gen_var(R), functor(A, _, S), gen_vars(S, T), U=..[suspension, _, V, _, _, _, _|T], create_get_mutable_ref(active, V, W), X=(Q=U, W), Y=[[Q|R]|M], build_head(F, G, H, Y, Z), A1=[R|M], build_head(F, G, H, A1, B1), C1=B1, A=..[_|D1], pairup(D1, T, E1), head_arg_matches(E1, N, F1, G1), different_from_other_susps(A, Q, B, P, H1), guard_body_copies(C, G1, I1, J1), gen_uncond_attach_goal(F/G, O, K1, L1), gen_state_cond_call(O, G, C1, L1, M1), history_susps(E, [Q|P], O, [], N1), bagof('chr novel_production'(O1, P1), (member(O1, N1), P1=Q1), R1), list2conj(R1, S1), T1=..[t, D|N1], ( chr_pp_flag(debugable, on) -> C=rule(_, _, K, L), my_term_copy(K-L, G1, _, U1-V1), W1='chr debug_event'(try([], [O, Q|P], U1, V1)), X1='chr debug_event'(apply([], [O, Q|P], U1, V1)) ; W1=true, X1=true ), Y1=(Z:-X, H1, F1, Q1=T1, S1, I1, W1->X1, 'chr extend_history'(O, Q1), K1, J1, M1;C1), I=[Y1|J]. history_susps(A, B, C, D, E) :- ( A==0 -> reverse(B, F), append(F, [C|D], E) ; B=[G|H], I is A-1, history_susps(I, H, C, [G|D], E) ). get_prop_inner_loop_vars([A], B, C, D, E, []) :- !, functor(A, _, F), head_info(A, F, _, E, G, H), head_arg_matches(H, [], _, D), extra_active_delegate_variables(A, B, D, I), append(G, I, C). get_prop_inner_loop_vars([A|B], C, D, E, F, [G|H]) :- get_prop_inner_loop_vars(B, [A|C], I, J, F, H), functor(A, _, K), gen_var(L), head_info(A, K, _, G, _, M), head_arg_matches(M, J, _, E), passive_delegate_variables(A, B, C, E, N), append(N, [G, L|I], D). propagation_end([A|B], C, D, E/F, G, H, I) :- D=rule(_, _, J, K), gen_var_susp_list_for(B, [A, C, J, K], _, L, M, N), O=[[]|L], build_head(E, F, G, O, P), ( G=[0|_] -> next_id(G, Q), R=M ; dec_id(G, Q), R=[N|M] ), build_head(E, F, Q, R, S), T=S, U=(P:-T), H=[U|I]. gen_var_susp_list_for([A], B, C, D, E, F) :- !, functor(A, _, G), head_info(A, G, _, F, E, H), head_arg_matches(H, [], _, C), extra_active_delegate_variables(A, B, C, I), append(E, I, D). gen_var_susp_list_for([A|B], C, D, E, F, G) :- gen_var_susp_list_for(B, [A|C], H, F, _, _), functor(A, _, I), gen_var(G), head_info(A, I, _, J, _, K), head_arg_matches(K, H, _, D), passive_delegate_variables(A, B, C, D, L), append(L, [J, G|F], E). propagation_accumulator([A|B], [C|D], E, F/G, H, I, J) :- E=rule(_, _, K, L), pre_vars_and_susps(D, [C, A, B, K, L], M, N, O), gen_var(P), functor(C, _, Q), gen_vars(Q, R), head_info(C, Q, R, S, _, T), head_arg_matches(T, N, U, V), W=..[suspension, _, X, _, _, _, _|R], different_from_other_susps(C, S, D, O, Y), create_get_mutable_ref(active, X, Z), A1=(S=W, Z, Y, U), lookup_passive_head(A, [C|D], V, B1, C1), inc_id(H, D1), E1=[[S|P]|M], build_head(F, G, H, E1, F1), passive_delegate_variables(C, D, [A, B, K, L], V, G1), append([C1|G1], [S, P|M], H1), build_head(F, G, D1, H1, I1), J1=[P|M], build_head(F, G, H, J1, K1), L1=(F1:-A1, B1->I1;K1), I=[L1|J]. pre_vars_and_susps([A], B, C, D, []) :- !, functor(A, _, E), head_info(A, E, _, _, F, G), head_arg_matches(G, [], _, D), extra_active_delegate_variables(A, B, D, H), append(F, H, C). pre_vars_and_susps([A|B], C, D, E, [F|G]) :- pre_vars_and_susps(B, [A|C], H, I, G), functor(A, _, J), gen_var(K), head_info(A, J, _, F, _, L), head_arg_matches(L, I, _, E), passive_delegate_variables(A, B, C, E, M), append(M, [F, K|H], D). reorder_heads(A, B, C, D, E, F) :- ( chr_pp_flag(reorder_heads, on) -> reorder_heads_main(A, B, C, D, E, F) ; E=C, F=D ). reorder_heads_main(A, B, C, D, E, F) :- term_variables(B, G), H=entry([], [], G, C, D, A), a_star(H, I^(chr_translate:final_data(I)), J^K^L^(chr_translate:expand_data(J, K, L)), M), M=entry(N, O, _, _, _, _), reverse(N, E), reverse(O, F). final_data(A) :- A=entry(_, _, _, _, [], _). expand_data(A, B, C) :- A=entry(D, E, F, G, H, I), term_variables(A, _), B=entry([J|D], [K|E], L, M, N, I), select2(J, K, G, H, M, N), order_score(J, K, F, M, I, C), term_variables([J|F], L). order_score(A, B, C, D, E, F) :- functor(A, G, H), get_store_type(G/H, I), order_score(I, A, B, C, D, E, F). order_score(default, A, _, B, C, _, D) :- term_variables(A, E), term_variables(C, _), order_score_vars(E, B, C, 0, D). order_score(multi_hash(A), B, _, C, _, _, D) :- order_score_indexes(A, B, C, 0, D). order_score(global_ground, A, B, _, _, C, D) :- functor(A, _, E), ( get_pragma_unique(C, B, F), F==[] -> D=1 ; E==0 -> D=10 ; E>0 -> D=100 ). order_score(multi_store(A), B, C, D, E, F, G) :- find_with_var_identity(H, t(B, D, E), (member(I, A), chr_translate:order_score(I, B, C, D, E, F, H)), J), min_list(J, G). order_score_indexes([], _, _, A, A) :- A>0. order_score_indexes([A|B], C, D, E, F) :- multi_hash_key_args(A, C, G), ( forall(H, G, hprolog:memberchk_eq(H, D)) -> I is E+10 ; I=E ), order_score_indexes(B, C, D, I, F). order_score_vars([], _, _, A, B) :- ( A==0 -> B=0 ; B=A ). order_score_vars([A|B], C, D, E, F) :- ( memberchk_eq(A, C) -> G is E+10 ; memberchk_eq(A, D) -> G is E+100 ; G=E ), order_score_vars(B, C, D, G, F). create_get_mutable_ref(A, B, C) :- C=(B=mutable(A)). gen_var(_). gen_vars(A, B) :- length(B, A). head_info(A, B, C, D, E, F) :- vars_susp(B, C, D, E), A=..[_|G], pairup(G, C, F). inc_id([A|B], [C|B]) :- C is A+1. dec_id([A|B], [C|B]) :- C is A-1. extend_id(A, [0|A]). next_id([_, A|B], [C|B]) :- C is A+1. build_head(A, B, C, D, E) :- buildName(A, B, C, F), E=..[F|D]. buildName(A, B, C, D) :- atom_concat(A, /, E), atomic_concat(E, B, F), buildName_(C, F, D). buildName_([], A, A). buildName_([A|B], C, D) :- buildName_(B, C, E), atom_concat(E, '__', F), atomic_concat(F, A, D). vars_susp(A, B, C, D) :- length(B, A), append(B, [C], D). make_attr(A, B, C, D) :- length(C, A), D=..[v, B|C]. or_pattern(A, B) :- C is A-1, B is 1< list2conj(B, C) ; C=(A, D), list2conj(B, D) ). list2disj([], fail). list2disj([A], B) :- !, B=A. list2disj([A|B], C) :- ( A==fail -> list2disj(B, C) ; C=(A;D), list2disj(B, D) ). atom_concat_list([A], A) :- !. atom_concat_list([A|B], C) :- atom_concat_list(B, D), atomic_concat(A, D, C). make_name(A, B/C, D) :- atom_concat_list([A, B, /, C], D). 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(A, B, [C|D], [E|F], [C|G], [E|H]) :- select2(A, B, D, F, G, H). pair_all_with([], _, []). pair_all_with([A|B], C, [A-C|D]) :- pair_all_with(B, C, D). lookup_passive_head(A, B, C, D, E) :- functor(A, F, G), get_store_type(F/G, H), lookup_passive_head(H, A, B, C, D, E). lookup_passive_head(default, A, B, C, D, E) :- passive_head_via(A, B, [], C, D, F, G), instantiate_pattern_goals(G), get_max_constraint_index(H), ( H==1 -> E=F ; functor(A, I, J), get_constraint_index(I/J, K), make_attr(H, _, L, F), nth1(K, L, E) ). lookup_passive_head(multi_hash(A), B, _, C, D, E) :- once(( member(F, A), multi_hash_key_args(F, B, G), translate(G, C, H) )), ( H=[I] -> true ; I=..[k|H] ), functor(B, J, K), multi_hash_via_lookup_name(J/K, F, L), D=..[L, I, E], update_store_type(J/K, multi_hash([F])). lookup_passive_head(global_ground, A, _, _, B, C) :- functor(A, D, E), global_ground_store_name(D/E, F), make_get_store_goal(F, C, B), update_store_type(D/E, global_ground). lookup_passive_head(multi_store(A), B, C, D, E, F) :- once(( member(G, A), lookup_passive_head(G, B, C, D, E, F) )). assume_constraint_stores([]). assume_constraint_stores([A|B]) :- ( \+ may_trigger(A), is_attached(A), get_store_type(A, default) -> get_indexed_arguments(A, C), findall(D, ( sublist(D, C), D\==[] ), E), assumed_store_type(A, multi_store([multi_hash(E), global_ground])) ; true ), assume_constraint_stores(B). get_indexed_arguments(A, B) :- A=_/C, get_indexed_arguments(1, C, A, B). get_indexed_arguments(A, B, C, D) :- ( A>B -> D=[] ; ( is_indexed_argument(C, A) -> D=[A|E] ; D=E ), F is A+1, get_indexed_arguments(F, B, C, E) ). validate_store_type_assumptions([]). validate_store_type_assumptions([A|B]) :- validate_store_type_assumption(A), validate_store_type_assumptions(B). verbosity_on :- prolog_flag(verbose, A), A==yes. attr_unify_hook(_, _) :- write('ERROR: Unexpected triggering of attr_unify_hook/2 in module '), writeln(chr_translate). remove_constraint_internal(A, B, C) :- arg(2, A, D), 'chr get_mutable'(E, D), 'chr update_mutable'(removed, D), ( compound(E) -> B=[], C=no ; E==removed -> B=[], C=no ; C=yes, chr_indexed_variables(A, B) ). activate_constraint(A, B, C, D) :- arg(2, C, E), 'chr get_mutable'(F, E), 'chr update_mutable'(active, E), ( nonvar(D) -> true ; arg(4, C, G), 'chr get_mutable'(H, G), D is H+1, 'chr update_mutable'(D, G) ), ( compound(F) -> term_variables(F, B), 'chr none_locked'(B), A=yes ; F==removed -> chr_indexed_variables(C, B), A=yes ; B=[], A=no ). allocate_constraint(A, B, C, D) :- B=..[suspension, E, F, A, G, H, C|D], 'chr create_mutable'(0, G), 'chr empty_history'(I), 'chr create_mutable'(I, H), chr_indexed_variables(B, J), 'chr create_mutable'(passive(J), F), 'chr gen_id'(E). chr_indexed_variables(_, []). insert_constraint_internal(yes, A, B, C, D, E) :- B=..[suspension, F, G, C, H, I, D|E], chr_indexed_variables(B, A), 'chr none_locked'(A), 'chr create_mutable'(active, G), 'chr create_mutable'(0, H), 'chr empty_history'(J), 'chr create_mutable'(J, I), 'chr gen_id'(F). '$insert_in_store_constraint/2'(A) :- arg(8, A, B), nb_getval('$chr_store_multi_hash_chr_translate:constraint/2-2', C), insert_ht(C, B, A), true. '$delete_from_store_constraint/2'(A) :- arg(8, A, B), nb_getval('$chr_store_multi_hash_chr_translate:constraint/2-2', C), delete_ht(C, B, A), true. '$insert_in_store_constraint_count/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:constraint_count/1', B), b_setval('$chr_store_global_ground_chr_translate:constraint_count/1', [A|B]). '$delete_from_store_constraint_count/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:constraint_count/1', B), 'chr sbag_del_element'(B, A, C), b_setval('$chr_store_global_ground_chr_translate:constraint_count/1', C). '$insert_in_store_constraint_index/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:constraint_index/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_constraint_index/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:constraint_index/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_max_constraint_index/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:max_constraint_index/1', B), b_setval('$chr_store_global_ground_chr_translate:max_constraint_index/1', [A|B]). '$delete_from_store_max_constraint_index/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:max_constraint_index/1', B), 'chr sbag_del_element'(B, A, C), b_setval('$chr_store_global_ground_chr_translate:max_constraint_index/1', C). '$insert_in_store_target_module/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:target_module/1', B), b_setval('$chr_store_global_ground_chr_translate:target_module/1', [A|B]). '$delete_from_store_target_module/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:target_module/1', B), 'chr sbag_del_element'(B, A, C), b_setval('$chr_store_global_ground_chr_translate:target_module/1', C). '$insert_in_store_attached/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:attached/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_attached/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:attached/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_indexed_argument/2'(A) :- ( arg(7, A, B), arg(8, A, C) ), nb_getval('$chr_store_multi_hash_chr_translate:indexed_argument/2-12', D), insert_ht(D, k(B, C), A), true. '$delete_from_store_indexed_argument/2'(A) :- ( arg(7, A, B), arg(8, A, C) ), nb_getval('$chr_store_multi_hash_chr_translate:indexed_argument/2-12', D), delete_ht(D, k(B, C), A), true. '$insert_in_store_constraint_mode/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:constraint_mode/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_constraint_mode/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:constraint_mode/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_store_type/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:store_type/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_store_type/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:store_type/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_actual_store_types/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:actual_store_types/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_actual_store_types/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:actual_store_types/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_assumed_store_type/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:assumed_store_type/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_assumed_store_type/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:assumed_store_type/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_rule_count/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:rule_count/1', B), b_setval('$chr_store_global_ground_chr_translate:rule_count/1', [A|B]). '$delete_from_store_rule_count/1'(A) :- nb_getval('$chr_store_global_ground_chr_translate:rule_count/1', B), 'chr sbag_del_element'(B, A, C), b_setval('$chr_store_global_ground_chr_translate:rule_count/1', C). '$insert_in_store_passive/2'(A) :- ( arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:passive/2-1', C), insert_ht(C, B, A) ), true, ( arg(7, A, D), arg(8, A, E) ), nb_getval('$chr_store_multi_hash_chr_translate:passive/2-12', F), insert_ht(F, k(D, E), A), true. '$delete_from_store_passive/2'(A) :- ( arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:passive/2-1', C), delete_ht(C, B, A) ), true, ( arg(7, A, D), arg(8, A, E) ), nb_getval('$chr_store_multi_hash_chr_translate:passive/2-12', F), delete_ht(F, k(D, E), A), true. '$insert_in_store_pragma_unique/3'(A) :- ( arg(7, A, B), arg(8, A, C) ), nb_getval('$chr_store_multi_hash_chr_translate:pragma_unique/3-12', D), insert_ht(D, k(B, C), A), true. '$delete_from_store_pragma_unique/3'(A) :- ( arg(7, A, B), arg(8, A, C) ), nb_getval('$chr_store_multi_hash_chr_translate:pragma_unique/3-12', D), delete_ht(D, k(B, C), A), true. '$insert_in_store_occurrence/4'(A) :- ( arg(9, A, B), nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-3', C), insert_ht(C, B, A) ), true, ( arg(8, A, D), nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-2', E), insert_ht(E, D, A) ), true, ( arg(7, A, F), arg(8, A, G), arg(9, A, H), arg(10, A, I) ), nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-1234', J), insert_ht(J, k(F, G, H, I), A), true. '$delete_from_store_occurrence/4'(A) :- ( arg(9, A, B), nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-3', C), delete_ht(C, B, A) ), true, ( arg(8, A, D), nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-2', E), delete_ht(E, D, A) ), true, ( arg(7, A, F), arg(8, A, G), arg(9, A, H), arg(10, A, I) ), nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-1234', J), delete_ht(J, k(F, G, H, I), A), true. '$insert_in_store_max_occurrence/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:max_occurrence/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_max_occurrence/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:max_occurrence/2-1', C), delete_ht(C, B, A), true. '$insert_in_store_allocation_occurrence/2'(A) :- ( arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-1', C), insert_ht(C, B, A) ), true, ( arg(7, A, D), arg(8, A, E), nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-12', F), insert_ht(F, k(D, E), A) ), true, nb_getval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', G), b_setval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', [A|G]). '$delete_from_store_allocation_occurrence/2'(A) :- ( arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-1', C), delete_ht(C, B, A) ), true, ( arg(7, A, D), arg(8, A, E), nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-12', F), delete_ht(F, k(D, E), A) ), true, nb_getval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', G), 'chr sbag_del_element'(G, A, H), b_setval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', H). '$insert_in_store_rule/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:rule/2-1', C), insert_ht(C, B, A), true. '$delete_from_store_rule/2'(A) :- arg(7, A, B), nb_getval('$chr_store_multi_hash_chr_translate:rule/2-1', C), delete_ht(C, B, A), true. '$enumerate_suspensions'(A) :- ( nb_getval('$chr_store_multi_hash_chr_translate:constraint/2-2', B), value_ht(B, A) ; nb_getval('$chr_store_global_ground_chr_translate:constraint_count/1', C), member(A, C) ; nb_getval('$chr_store_multi_hash_chr_translate:constraint_index/2-1', D), value_ht(D, A) ; nb_getval('$chr_store_global_ground_chr_translate:max_constraint_index/1', E), member(A, E) ; nb_getval('$chr_store_global_ground_chr_translate:target_module/1', F), member(A, F) ; nb_getval('$chr_store_multi_hash_chr_translate:attached/2-1', G), value_ht(G, A) ; nb_getval('$chr_store_multi_hash_chr_translate:indexed_argument/2-12', H), value_ht(H, A) ; nb_getval('$chr_store_multi_hash_chr_translate:constraint_mode/2-1', I), value_ht(I, A) ; nb_getval('$chr_store_multi_hash_chr_translate:store_type/2-1', J), value_ht(J, A) ; nb_getval('$chr_store_multi_hash_chr_translate:actual_store_types/2-1', K), value_ht(K, A) ; nb_getval('$chr_store_multi_hash_chr_translate:assumed_store_type/2-1', L), value_ht(L, A) ; nb_getval('$chr_store_global_ground_chr_translate:rule_count/1', M), member(A, M) ; nb_getval('$chr_store_multi_hash_chr_translate:passive/2-1', N), value_ht(N, A) ; nb_getval('$chr_store_multi_hash_chr_translate:pragma_unique/3-12', O), value_ht(O, A) ; nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-3', P), value_ht(P, A) ; nb_getval('$chr_store_multi_hash_chr_translate:max_occurrence/2-1', Q), value_ht(Q, A) ; nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-1', R), value_ht(R, A) ; nb_getval('$chr_store_multi_hash_chr_translate:rule/2-1', S), value_ht(S, A) ). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:constraint/2-2', A). '$via1_multi_hash_constraint/2-2'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:constraint/2-2', C), lookup_ht(C, A, B). :- nb_setval('$chr_store_global_ground_chr_translate:constraint_count/1', []). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:constraint_index/2-1', A). '$via1_multi_hash_constraint_index/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:constraint_index/2-1', C), lookup_ht(C, A, B). :- nb_setval('$chr_store_global_ground_chr_translate:max_constraint_index/1', []). :- nb_setval('$chr_store_global_ground_chr_translate:target_module/1', []). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:attached/2-1', A). '$via1_multi_hash_attached/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:attached/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:indexed_argument/2-12', A). '$via1_multi_hash_indexed_argument/2-12'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:indexed_argument/2-12', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:constraint_mode/2-1', A). '$via1_multi_hash_constraint_mode/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:constraint_mode/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:store_type/2-1', A). '$via1_multi_hash_store_type/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:store_type/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:actual_store_types/2-1', A). '$via1_multi_hash_actual_store_types/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:actual_store_types/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:assumed_store_type/2-1', A). '$via1_multi_hash_assumed_store_type/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:assumed_store_type/2-1', C), lookup_ht(C, A, B). :- nb_setval('$chr_store_global_ground_chr_translate:rule_count/1', []). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:passive/2-1', A). '$via1_multi_hash_passive/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:passive/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:passive/2-12', A). '$via1_multi_hash_passive/2-12'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:passive/2-12', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:pragma_unique/3-12', A). '$via1_multi_hash_pragma_unique/3-12'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:pragma_unique/3-12', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:occurrence/4-3', A). '$via1_multi_hash_occurrence/4-3'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-3', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:occurrence/4-2', A). '$via1_multi_hash_occurrence/4-2'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-2', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:occurrence/4-1234', A). '$via1_multi_hash_occurrence/4-1234'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:occurrence/4-1234', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:max_occurrence/2-1', A). '$via1_multi_hash_max_occurrence/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:max_occurrence/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-1', A). '$via1_multi_hash_allocation_occurrence/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-1', C), lookup_ht(C, A, B). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-12', A). '$via1_multi_hash_allocation_occurrence/2-12'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:allocation_occurrence/2-12', C), lookup_ht(C, A, B). :- nb_setval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', []). :- new_ht(A), nb_setval('$chr_store_multi_hash_chr_translate:rule/2-1', A). '$via1_multi_hash_rule/2-1'(A, B) :- nb_getval('$chr_store_multi_hash_chr_translate:rule/2-1', C), lookup_ht(C, A, B). constraint(A, B) :- 'constraint/2__0'(A, B, _). 'constraint/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'constraint/2__0'(A, B, C), constraint(A, B), [A, B]), '$insert_in_store_constraint/2'(C). get_constraint(A, B) :- 'get_constraint/2__0'(A, B, _). 'get_constraint/2__0'(A, B, _) :- '$via1_multi_hash_constraint/2-2'(B, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), G==B, !, A=F. 'get_constraint/2__0'(_, _, _) :- !, fail. constraint_count(A) :- 'constraint_count/1__0'(A, _). 'constraint_count/1__0'(A, B) :- insert_constraint_internal(_, _, B, chr_translate:'constraint_count/1__0'(A, B), constraint_count(A), [A]), '$insert_in_store_constraint_count/1'(B). get_constraint_count(A) :- 'get_constraint_count/1__0'(A, _). 'get_constraint_count/1__0'(A, _) :- nb_getval('$chr_store_global_ground_chr_translate:constraint_count/1', B), member(C, B), C=suspension(_, D, _, _, _, _, E), D=mutable(active), !, A=E. 'get_constraint_count/1__0'(A, _) :- !, A=0. constraint_index(A, B) :- 'constraint_index/2__0'(A, B, _). 'constraint_index/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'constraint_index/2__0'(A, B, C), constraint_index(A, B), [A, B]), '$insert_in_store_constraint_index/2'(C). get_constraint_index(A, B) :- 'get_constraint_index/2__0'(A, B, _). 'get_constraint_index/2__0'(A, B, _) :- '$via1_multi_hash_constraint_index/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_constraint_index/2__0'(_, _, _) :- !, fail. max_constraint_index(A) :- 'max_constraint_index/1__0'(A, _). 'max_constraint_index/1__0'(A, B) :- insert_constraint_internal(_, _, B, chr_translate:'max_constraint_index/1__0'(A, B), max_constraint_index(A), [A]), '$insert_in_store_max_constraint_index/1'(B). get_max_constraint_index(A) :- 'get_max_constraint_index/1__0'(A, _). 'get_max_constraint_index/1__0'(A, _) :- nb_getval('$chr_store_global_ground_chr_translate:max_constraint_index/1', B), member(C, B), C=suspension(_, D, _, _, _, _, E), D=mutable(active), !, A=E. 'get_max_constraint_index/1__0'(A, _) :- !, A=0. target_module(A) :- 'target_module/1__0'(A, _). 'target_module/1__0'(A, B) :- insert_constraint_internal(_, _, B, chr_translate:'target_module/1__0'(A, B), target_module(A), [A]), '$insert_in_store_target_module/1'(B). get_target_module(A) :- 'get_target_module/1__0'(A, _). 'get_target_module/1__0'(A, _) :- nb_getval('$chr_store_global_ground_chr_translate:target_module/1', B), member(C, B), C=suspension(_, D, _, _, _, _, E), D=mutable(active), !, A=E. 'get_target_module/1__0'(A, _) :- !, A=user. attached(A, B) :- 'attached/2__0'(A, B, _). 'attached/2__0'(A, _, _) :- '$via1_multi_hash_attached/2-1'(A, B), member(C, B), C=suspension(_, D, _, _, _, _, E, F), D=mutable(active), E==A, F==yes, !. 'attached/2__0'(A, B, C) :- B==yes, '$via1_multi_hash_attached/2-1'(A, D), !, allocate_constraint(chr_translate:'attached/2__0'(A, B, C), C, attached(A, B), [A, B]), 'attached/2__0__0'(D, A, B, C). 'attached/2__0__0'([], A, B, C) :- 'attached/2__1'(A, B, C). 'attached/2__0__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, _), F=mutable(active), G==C -> remove_constraint_internal(A, _, H), ( H==yes -> '$delete_from_store_attached/2'(A) ; true ), 'attached/2__0__0'(B, C, D, E) ; 'attached/2__0__0'(B, C, D, E) ). 'attached/2__0'(A, B, C) :- allocate_constraint(chr_translate:'attached/2__0'(A, B, C), C, attached(A, B), [A, B]), 'attached/2__1'(A, B, C). 'attached/2__1'(A, _, B) :- '$via1_multi_hash_attached/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, G==no, !, ( var(B) -> true ; remove_constraint_internal(B, _, H), ( H==yes -> '$delete_from_store_attached/2'(B) ; true ) ). 'attached/2__1'(A, B, C) :- B==no, '$via1_multi_hash_attached/2-1'(A, D), !, 'attached/2__1__0'(D, A, B, C). 'attached/2__1__0'([], A, B, C) :- 'attached/2__2'(A, B, C). 'attached/2__1__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, _), F=mutable(active), G==C -> remove_constraint_internal(A, _, H), ( H==yes -> '$delete_from_store_attached/2'(A) ; true ), 'attached/2__1__0'(B, C, D, E) ; 'attached/2__1__0'(B, C, D, E) ). 'attached/2__1'(A, B, C) :- 'attached/2__2'(A, B, C). 'attached/2__2'(A, B, C) :- B==maybe, '$via1_multi_hash_attached/2-1'(A, D), ( member(E, D), E=suspension(_, F, _, _, _, _, G, H), F=mutable(active), G==A, H==maybe, !, ( var(C) -> true ; remove_constraint_internal(C, _, I), ( I==yes -> '$delete_from_store_attached/2'(C) ; true ) ) ; !, 'attached/2__2__0'(D, A, B, C) ). 'attached/2__2__0'([], A, B, C) :- 'attached/2__3'(A, B, C). 'attached/2__2__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, H), F=mutable(active), G==C, H==maybe -> remove_constraint_internal(A, _, I), ( I==yes -> '$delete_from_store_attached/2'(A) ; true ), 'attached/2__2__0'(B, C, D, E) ; 'attached/2__2__0'(B, C, D, E) ). 'attached/2__2'(A, B, C) :- 'attached/2__3'(A, B, C). 'attached/2__3'(_, _, A) :- activate_constraint(B, _, A, _), ( B==yes -> '$insert_in_store_attached/2'(A) ; true ). is_attached(A) :- 'is_attached/1__0'(A, _). 'is_attached/1__0'(A, _) :- '$via1_multi_hash_attached/2-1'(A, B), member(C, B), C=suspension(_, D, _, _, _, _, E, F), D=mutable(active), E==A, !, F\==no. 'is_attached/1__0'(_, _) :- !. indexed_argument(A, B) :- 'indexed_argument/2__0'(A, B, _). 'indexed_argument/2__0'(A, B, C) :- '$via1_multi_hash_indexed_argument/2-12'(k(A, B), D), ( member(E, D), E=suspension(_, F, _, _, _, _, G, H), F=mutable(active), G==A, H==B, ! ; !, allocate_constraint(chr_translate:'indexed_argument/2__0'(A, B, C), C, indexed_argument(A, B), [A, B]), 'indexed_argument/2__0__0'(D, A, B, C) ). 'indexed_argument/2__0__0'([], A, B, C) :- 'indexed_argument/2__1'(A, B, C). 'indexed_argument/2__0__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, H), F=mutable(active), G==C, H==D -> remove_constraint_internal(A, _, I), ( I==yes -> '$delete_from_store_indexed_argument/2'(A) ; true ), 'indexed_argument/2__0__0'(B, C, D, E) ; 'indexed_argument/2__0__0'(B, C, D, E) ). 'indexed_argument/2__0'(A, B, C) :- allocate_constraint(chr_translate:'indexed_argument/2__0'(A, B, C), C, indexed_argument(A, B), [A, B]), 'indexed_argument/2__1'(A, B, C). 'indexed_argument/2__1'(_, _, A) :- activate_constraint(B, _, A, _), ( B==yes -> '$insert_in_store_indexed_argument/2'(A) ; true ). is_indexed_argument(A, B) :- 'is_indexed_argument/2__0'(A, B, _). 'is_indexed_argument/2__0'(A, B, _) :- '$via1_multi_hash_indexed_argument/2-12'(k(A, B), C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, G==B, !. 'is_indexed_argument/2__0'(_, _, _) :- !, fail. constraint_mode(A, B) :- 'constraint_mode/2__0'(A, B, _). 'constraint_mode/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'constraint_mode/2__0'(A, B, C), constraint_mode(A, B), [A, B]), '$insert_in_store_constraint_mode/2'(C). get_constraint_mode(A, B) :- 'get_constraint_mode/2__0'(A, B, _). 'get_constraint_mode/2__0'(A, B, _) :- '$via1_multi_hash_constraint_mode/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_constraint_mode/2__0'(A, B, _) :- !, A=_/C, length(B, C), set_elems(B, ?). may_trigger(A) :- 'may_trigger/1__0'(A, _). 'may_trigger/1__0'(A, _) :- !, is_attached(A), get_constraint_mode(A, B), has_nonground_indexed_argument(A, 1, B). has_nonground_indexed_argument(A, B, C) :- 'has_nonground_indexed_argument/3__0'(A, B, C, _). 'has_nonground_indexed_argument/3__0'(A, B, C, _) :- nonvar(C), C=[D|E], !, ( is_indexed_argument(A, B), D\==(+) -> true ; F is B+1, has_nonground_indexed_argument(A, F, E) ). 'has_nonground_indexed_argument/3__0'(_, _, _, _) :- !, fail. store_type(A, B) :- 'store_type/2__0'(A, B, _). 'store_type/2__0'(A, B, _) :- nonvar(B), B=atom_hash(C), !, store_type(A, multi_hash([C])). 'store_type/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'store_type/2__0'(A, B, C), store_type(A, B), [A, B]), '$insert_in_store_store_type/2'(C). get_store_type(A, B) :- 'get_store_type/2__0'(A, B, _). 'get_store_type/2__0'(A, B, _) :- '$via1_multi_hash_store_type/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_store_type/2__0'(A, B, _) :- '$via1_multi_hash_assumed_store_type/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_store_type/2__0'(_, A, _) :- !, A=default. update_store_type(A, B) :- 'update_store_type/2__0'(A, B, _). 'update_store_type/2__0'(A, B, _) :- '$via1_multi_hash_actual_store_types/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, ( 'chr lock'(B), 'chr lock'(G), member(B, G), 'chr unlock'(B), 'chr unlock'(G), ! ; !, remove_constraint_internal(D, _, H), ( H==yes -> '$delete_from_store_actual_store_types/2'(D) ; true ), actual_store_types(A, [B|G]) ). 'update_store_type/2__0'(A, B, _) :- !, actual_store_types(A, [B]). actual_store_types(A, B) :- 'actual_store_types/2__0'(A, B, _). 'actual_store_types/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'actual_store_types/2__0'(A, B, C), actual_store_types(A, B), [A, B]), '$insert_in_store_actual_store_types/2'(C). assumed_store_type(A, B) :- 'assumed_store_type/2__0'(A, B, _). 'assumed_store_type/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'assumed_store_type/2__0'(A, B, C), assumed_store_type(A, B), [A, B]), '$insert_in_store_assumed_store_type/2'(C). validate_store_type_assumption(A) :- 'validate_store_type_assumption/1__0'(A, _). 'validate_store_type_assumption/1__0'(A, _) :- '$via1_multi_hash_assumed_store_type/2-1'(A, B), '$via1_multi_hash_actual_store_types/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, member(H, B), H=suspension(_, I, _, _, _, _, J, _), I=mutable(active), J==A, !, remove_constraint_internal(D, _, K), ( K==yes -> '$delete_from_store_actual_store_types/2'(D) ; true ), remove_constraint_internal(H, _, L), ( L==yes -> '$delete_from_store_assumed_store_type/2'(H) ; true ), store_type(A, multi_store(G)). 'validate_store_type_assumption/1__0'(A, _) :- '$via1_multi_hash_store_type/2-1'(A, B), '$via1_multi_hash_actual_store_types/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, member(H, B), H=suspension(_, I, _, _, _, _, J, _), I=mutable(active), J==A, !, remove_constraint_internal(D, _, K), ( K==yes -> '$delete_from_store_actual_store_types/2'(D) ; true ), remove_constraint_internal(H, _, L), ( L==yes -> '$delete_from_store_store_type/2'(H) ; true ), store_type(A, multi_store(G)). 'validate_store_type_assumption/1__0'(_, _) :- !. rule_count(A) :- 'rule_count/1__0'(A, _). 'rule_count/1__0'(A, B) :- insert_constraint_internal(_, _, B, chr_translate:'rule_count/1__0'(A, B), rule_count(A), [A]), '$insert_in_store_rule_count/1'(B). inc_rule_count(A) :- 'inc_rule_count/1__0'(A, _). 'inc_rule_count/1__0'(A, _) :- nb_getval('$chr_store_global_ground_chr_translate:rule_count/1', B), member(C, B), C=suspension(_, D, _, _, _, _, E), D=mutable(active), !, remove_constraint_internal(C, _, F), ( F==yes -> '$delete_from_store_rule_count/1'(C) ; true ), A is E+1, rule_count(A). 'inc_rule_count/1__0'(A, _) :- !, A=1, rule_count(A). get_rule_count(A) :- 'get_rule_count/1__0'(A, _). 'get_rule_count/1__0'(A, _) :- nb_getval('$chr_store_global_ground_chr_translate:rule_count/1', B), member(C, B), C=suspension(_, D, _, _, _, _, E), D=mutable(active), !, A=E. 'get_rule_count/1__0'(A, _) :- !, A=0. passive(A, B) :- 'passive/2__0'(A, B, _). 'passive/2__0'(A, B, C) :- nb_getval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', D), !, allocate_constraint(chr_translate:'passive/2__0'(A, B, C), C, passive(A, B), [A, B]), 'passive/2__0__0'(D, A, B, C). 'passive/2__0__0'([], A, B, C) :- 'passive/2__1'(A, B, C). 'passive/2__0__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, H), F=mutable(active), '$via1_multi_hash_occurrence/4-1234'(k(G, H, C, D), I), member(J, I), J=suspension(_, K, _, _, _, _, L, M, N, O), K=mutable(active), L==G, M==H, N==C, O==D -> remove_constraint_internal(A, _, P), ( P==yes -> '$delete_from_store_allocation_occurrence/2'(A) ; true ), activate_constraint(Q, _, E, R), ( Q==yes -> '$insert_in_store_passive/2'(E) ; true ), S is H+1, allocation_occurrence(G, S), ( E=suspension(_, T, _, U, _, _, _, _), T=mutable(active), U=mutable(R) -> 'chr update_mutable'(inactive, T), 'passive/2__0__0'(B, C, D, E) ; true ) ; 'passive/2__0__0'(B, C, D, E) ). 'passive/2__0'(A, B, C) :- allocate_constraint(chr_translate:'passive/2__0'(A, B, C), C, passive(A, B), [A, B]), 'passive/2__1'(A, B, C). 'passive/2__1'(_, _, A) :- activate_constraint(B, _, A, _), ( B==yes -> '$insert_in_store_passive/2'(A) ; true ). is_passive(A, B) :- 'is_passive/2__0'(A, B, _). 'is_passive/2__0'(A, B, _) :- '$via1_multi_hash_passive/2-12'(k(A, B), C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, G==B, !. 'is_passive/2__0'(_, _, _) :- !, fail. any_passive_head(A) :- 'any_passive_head/1__0'(A, _). 'any_passive_head/1__0'(A, _) :- '$via1_multi_hash_passive/2-1'(A, B), member(C, B), C=suspension(_, D, _, _, _, _, E, _), D=mutable(active), E==A, !. 'any_passive_head/1__0'(_, _) :- !, fail. pragma_unique(A, B, C) :- 'pragma_unique/3__0'(A, B, C, _). 'pragma_unique/3__0'(A, B, C, D) :- insert_constraint_internal(_, _, D, chr_translate:'pragma_unique/3__0'(A, B, C, D), pragma_unique(A, B, C), [A, B, C]), '$insert_in_store_pragma_unique/3'(D). get_pragma_unique(A, B, C) :- 'get_pragma_unique/3__0'(A, B, C, _). 'get_pragma_unique/3__0'(A, B, C, _) :- '$via1_multi_hash_pragma_unique/3-12'(k(A, B), D), member(E, D), E=suspension(_, F, _, _, _, _, G, H, I), F=mutable(active), G==A, H==B, !, C=I. 'get_pragma_unique/3__0'(_, _, _, _) :- !. occurrence(A, B, C, D) :- 'occurrence/4__0'(A, B, C, D, _). 'occurrence/4__0'(A, B, C, D, E) :- allocate_constraint(chr_translate:'occurrence/4__0'(A, B, C, D, E), E, occurrence(A, B, C, D), [A, B, C, D]), ( 'chr novel_production'(E, 46), !, 'chr extend_history'(E, 46), activate_constraint(F, _, E, G), ( F==yes -> '$insert_in_store_occurrence/4'(E) ; true ), max_occurrence(A, B), ( E=suspension(_, H, _, I, _, _, _, _, _, _), H=mutable(active), I=mutable(G) -> 'chr update_mutable'(inactive, H), 'occurrence/4__1'(A, B, C, D, E) ; true ) ; 'occurrence/4__1'(A, B, C, D, E) ). 'occurrence/4__1'(A, B, C, D, E) :- '$via1_multi_hash_allocation_occurrence/2-12'(k(A, B), F), !, 'occurrence/4__1__0'(F, A, B, C, D, E). 'occurrence/4__1__0'([], A, B, C, D, E) :- 'occurrence/4__2'(A, B, C, D, E). 'occurrence/4__1__0'([A|B], C, D, E, F, G) :- ( A=suspension(_, H, _, _, _, _, I, J), H=mutable(active), I==C, J==D, '$via1_multi_hash_rule/2-1'(E, K), member(L, K), L=suspension(_, M, _, _, _, _, N, O), M=mutable(active), N==E, 'chr lock'(O), 'chr lock'(F), O=pragma(_, ids(_, _), _, _, _), member(F, _), 'chr unlock'(O), 'chr unlock'(F) -> remove_constraint_internal(A, _, P), ( P==yes -> '$delete_from_store_allocation_occurrence/2'(A) ; true ), activate_constraint(Q, _, G, R), ( Q==yes -> '$insert_in_store_occurrence/4'(G) ; true ), S is D+1, allocation_occurrence(C, S), ( G=suspension(_, T, _, U, _, _, _, _, _, _), T=mutable(active), U=mutable(R) -> 'chr update_mutable'(inactive, T), 'occurrence/4__1__0'(B, C, D, E, F, G) ; true ) ; 'occurrence/4__1__0'(B, C, D, E, F, G) ). 'occurrence/4__1'(A, B, C, D, E) :- 'occurrence/4__2'(A, B, C, D, E). 'occurrence/4__2'(A, B, C, D, E) :- '$via1_multi_hash_allocation_occurrence/2-12'(k(A, B), F), !, 'occurrence/4__2__0'(F, A, B, C, D, E). 'occurrence/4__2__0'([], A, B, C, D, E) :- 'occurrence/4__3'(A, B, C, D, E). 'occurrence/4__2__0'([A|B], C, D, E, F, G) :- ( A=suspension(_, H, _, _, _, _, I, J), H=mutable(active), I==C, J==D, '$via1_multi_hash_rule/2-1'(E, K), member(L, K), L=suspension(_, M, _, _, _, _, N, O), M=mutable(active), N==E, 'chr lock'(O), O=pragma(rule(_, _, _, true), _, _, _, _), 'chr unlock'(O) -> remove_constraint_internal(A, _, P), ( P==yes -> '$delete_from_store_allocation_occurrence/2'(A) ; true ), activate_constraint(Q, _, G, R), ( Q==yes -> '$insert_in_store_occurrence/4'(G) ; true ), S is D+1, allocation_occurrence(C, S), ( G=suspension(_, T, _, U, _, _, _, _, _, _), T=mutable(active), U=mutable(R) -> 'chr update_mutable'(inactive, T), 'occurrence/4__2__0'(B, C, D, E, F, G) ; true ) ; 'occurrence/4__2__0'(B, C, D, E, F, G) ). 'occurrence/4__2'(A, B, C, D, E) :- 'occurrence/4__3'(A, B, C, D, E). 'occurrence/4__3'(A, B, C, D, E) :- '$via1_multi_hash_allocation_occurrence/2-12'(k(A, B), F), !, 'occurrence/4__3__0'(F, A, B, C, D, E). 'occurrence/4__3__0'([], A, B, C, D, E) :- 'occurrence/4__4'(A, B, C, D, E). 'occurrence/4__3__0'([A|B], C, D, E, F, G) :- ( A=suspension(_, H, _, _, _, _, I, J), H=mutable(active), I==C, J==D, '$via1_multi_hash_passive/2-12'(k(E, F), K), member(L, K), L=suspension(_, M, _, _, _, _, N, O), M=mutable(active), N==E, O==F -> remove_constraint_internal(A, _, P), ( P==yes -> '$delete_from_store_allocation_occurrence/2'(A) ; true ), activate_constraint(Q, _, G, R), ( Q==yes -> '$insert_in_store_occurrence/4'(G) ; true ), S is D+1, allocation_occurrence(C, S), ( G=suspension(_, T, _, U, _, _, _, _, _, _), T=mutable(active), U=mutable(R) -> 'chr update_mutable'(inactive, T), 'occurrence/4__3__0'(B, C, D, E, F, G) ; true ) ; 'occurrence/4__3__0'(B, C, D, E, F, G) ). 'occurrence/4__3'(A, B, C, D, E) :- 'occurrence/4__4'(A, B, C, D, E). 'occurrence/4__4'(_, _, _, _, A) :- activate_constraint(B, _, A, _), ( B==yes -> '$insert_in_store_occurrence/4'(A) ; true ). get_occurrence(A, B, C, D) :- 'get_occurrence/4__0'(A, B, C, D, _). 'get_occurrence/4__0'(A, B, C, D, _) :- '$via1_multi_hash_occurrence/4-2'(B, E), member(F, E), F=suspension(_, G, _, _, _, _, H, I, J, K), G=mutable(active), H==A, I==B, !, J=C, K=D. 'get_occurrence/4__0'(_, _, _, _, _) :- !, fail. max_occurrence(A, B) :- 'max_occurrence/2__0'(A, B, _). 'max_occurrence/2__0'(A, B, C) :- '$via1_multi_hash_max_occurrence/2-1'(A, D), ( member(E, D), E=suspension(_, F, _, _, _, _, G, H), F=mutable(active), G==A, H>=B, ! ; !, allocate_constraint(chr_translate:'max_occurrence/2__0'(A, B, C), C, max_occurrence(A, B), [A, B]), 'max_occurrence/2__0__0'(D, A, B, C) ). 'max_occurrence/2__0__0'([], A, B, C) :- 'max_occurrence/2__1'(A, B, C). 'max_occurrence/2__0__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, H), F=mutable(active), G==C, D>=H -> remove_constraint_internal(A, _, I), ( I==yes -> '$delete_from_store_max_occurrence/2'(A) ; true ), 'max_occurrence/2__0__0'(B, C, D, E) ; 'max_occurrence/2__0__0'(B, C, D, E) ). 'max_occurrence/2__0'(A, B, C) :- allocate_constraint(chr_translate:'max_occurrence/2__0'(A, B, C), C, max_occurrence(A, B), [A, B]), 'max_occurrence/2__1'(A, B, C). 'max_occurrence/2__1'(_, _, A) :- activate_constraint(B, _, A, _), ( B==yes -> '$insert_in_store_max_occurrence/2'(A) ; true ). get_max_occurrence(A, B) :- 'get_max_occurrence/2__0'(A, B, _). 'get_max_occurrence/2__0'(A, B, _) :- '$via1_multi_hash_max_occurrence/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_max_occurrence/2__0'(_, A, _) :- !, A=0. allocation_occurrence(A, B) :- 'allocation_occurrence/2__0'(A, B, _). 'allocation_occurrence/2__0'(A, B, _) :- '$via1_multi_hash_occurrence/4-2'(B, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G, H, I), E=mutable(active), F==A, G==B, ( '$via1_multi_hash_rule/2-1'(H, J), member(K, J), K=suspension(_, L, _, _, _, _, M, N), L=mutable(active), M==H, 'chr lock'(N), ( 'chr lock'(I), N=pragma(_, ids(_, _), _, _, _), member(I, _), 'chr unlock'(N), 'chr unlock'(I), !, O is B+1, allocation_occurrence(A, O) ; N=pragma(rule(_, _, _, true), _, _, _, _), 'chr unlock'(N), !, P is B+1, allocation_occurrence(A, P) ) ; '$via1_multi_hash_passive/2-12'(k(H, I), Q), member(R, Q), R=suspension(_, S, _, _, _, _, T, U), S=mutable(active), T==H, U==I, !, V is B+1, allocation_occurrence(A, V) ). 'allocation_occurrence/2__0'(A, B, C) :- insert_constraint_internal(_, _, C, chr_translate:'allocation_occurrence/2__0'(A, B, C), allocation_occurrence(A, B), [A, B]), '$insert_in_store_allocation_occurrence/2'(C). get_allocation_occurrence(A, B) :- 'get_allocation_occurrence/2__0'(A, B, _). 'get_allocation_occurrence/2__0'(A, B, _) :- '$via1_multi_hash_allocation_occurrence/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_allocation_occurrence/2__0'(_, _, _) :- !, fail. rule(A, B) :- 'rule/2__0'(A, B, _). 'rule/2__0'(A, B, C) :- nb_getval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', D), !, allocate_constraint(chr_translate:'rule/2__0'(A, B, C), C, rule(A, B), [A, B]), 'rule/2__0__0'(D, A, B, C). 'rule/2__0__0'([], A, B, C) :- 'rule/2__1'(A, B, C). 'rule/2__0__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, H), F=mutable(active), '$via1_multi_hash_occurrence/4-3'(C, I), member(J, I), J=suspension(_, K, _, _, _, _, L, M, N, O), K=mutable(active), L==G, M==H, N==C, 'chr lock'(D), 'chr lock'(O), D=pragma(_, ids(_, _), _, _, _), member(O, _), 'chr unlock'(D), 'chr unlock'(O) -> remove_constraint_internal(A, _, P), ( P==yes -> '$delete_from_store_allocation_occurrence/2'(A) ; true ), activate_constraint(Q, _, E, R), ( Q==yes -> '$insert_in_store_rule/2'(E) ; true ), S is H+1, allocation_occurrence(G, S), ( E=suspension(_, T, _, U, _, _, _, _), T=mutable(active), U=mutable(R) -> 'chr update_mutable'(inactive, T), 'rule/2__0__0'(B, C, D, E) ; true ) ; 'rule/2__0__0'(B, C, D, E) ). 'rule/2__0'(A, B, C) :- allocate_constraint(chr_translate:'rule/2__0'(A, B, C), C, rule(A, B), [A, B]), 'rule/2__1'(A, B, C). 'rule/2__1'(A, B, C) :- nb_getval('$chr_store_global_ground_chr_translate:allocation_occurrence/2', D), !, 'rule/2__1__0'(D, A, B, C). 'rule/2__1__0'([], A, B, C) :- 'rule/2__2'(A, B, C). 'rule/2__1__0'([A|B], C, D, E) :- ( A=suspension(_, F, _, _, _, _, G, H), F=mutable(active), '$via1_multi_hash_occurrence/4-3'(C, I), member(J, I), J=suspension(_, K, _, _, _, _, L, M, N, _), K=mutable(active), L==G, M==H, N==C, 'chr lock'(D), D=pragma(rule(_, _, _, true), _, _, _, _), 'chr unlock'(D) -> remove_constraint_internal(A, _, O), ( O==yes -> '$delete_from_store_allocation_occurrence/2'(A) ; true ), activate_constraint(P, _, E, Q), ( P==yes -> '$insert_in_store_rule/2'(E) ; true ), R is H+1, allocation_occurrence(G, R), ( E=suspension(_, S, _, T, _, _, _, _), S=mutable(active), T=mutable(Q) -> 'chr update_mutable'(inactive, S), 'rule/2__1__0'(B, C, D, E) ; true ) ; 'rule/2__1__0'(B, C, D, E) ). 'rule/2__1'(A, B, C) :- 'rule/2__2'(A, B, C). 'rule/2__2'(_, _, A) :- activate_constraint(B, _, A, _), ( B==yes -> '$insert_in_store_rule/2'(A) ; true ). get_rule(A, B) :- 'get_rule/2__0'(A, B, _). 'get_rule/2__0'(A, B, _) :- '$via1_multi_hash_rule/2-1'(A, C), member(D, C), D=suspension(_, E, _, _, _, _, F, G), E=mutable(active), F==A, !, B=G. 'get_rule/2__0'(_, _, _) :- !, fail.