chr_translate_bootstrap1.chr

   1 /*  Generated by CHR bootstrap compiler
   2     From: chr_translate_bootstrap1.pl
   3     Date: Fri Jan 12 13:49:11 2007
   4
   5     DO NOT EDIT.  EDIT THE CHR FILE INSTEAD
   6 */
   7
   8 :- module(chr_translate_bootstrap1,
   9           [ chr_translate/2
  10           ]).
  11 :- use_module(chr_runtime).
  12 :- style_check(- (discontiguous)).
  13 :- use_module(chr_runtime).
  14 :- style_check(- (discontiguous)).
  15 :- use_module(library(lists),
  16               [ append/3,
  17                 member/2,
  18                 permutation/2,
  19                 reverse/2
  20               ]).
  21 :- use_module(library(ordsets)).
  22 :- use_module(hprolog).
  23 :- use_module(pairlist).
  24 :- include(chr_op2).
  25 chr_translate(A, C) :-
  26         init_chr_pp_flags,
  27         partition_clauses(A, B, E, D),
  28         (   B==[]
  29         ->  C=D
  30         ;   check_rules(E, B),
  31             unique_analyse_optimise(E, F),
  32             check_attachments(F),
  33             set_constraint_indices(B, 1),
  34             store_management_preds(B, G),
  35             constraints_code(B, F, H),
  36             append([D, G, H], C)
  37         ),
  38         chr_clear.
  39 store_management_preds(A, E) :-
  40         generate_attach_detach_a_constraint_all(A, B),
  41         generate_attach_increment(C),
  42         generate_attr_unify_hook(D),
  43         append([B, C, D], E).
  44 partition_clauses([], [], [], []).
  45 partition_clauses([A|M], B, C, E) :-
  46         (   rule(A, D)
  47         ->  B=G,
  48             C=[D|H],
  49             E=I
  50         ;   is_declaration(A, F)
  51         ->  append(F, G, B),
  52             C=H,
  53             E=I
  54         ;   is_module_declaration(A, J)
  55         ->  target_module(J),
  56             B=G,
  57             C=H,
  58             E=[A|I]
  59         ;   A=handler(_)
  60         ->  format('CHR compiler WARNING: ~w.\n', [A]),
  61             format('    `-->  SICStus compatibility: ignoring handler/1 declaration.\n', []),
  62             B=G,
  63             C=H,
  64             E=I
  65         ;   A=rules(_)
  66         ->  format('CHR compiler WARNING: ~w.\n', [A]),
  67             format('    `-->  SICStus compatibility: ignoring rules/1 declaration.\n', []),
  68             B=G,
  69             C=H,
  70             E=I
  71         ;   A= (:-chr_option(K, L))
  72         ->  handle_option(K, L),
  73             B=G,
  74             C=H,
  75             E=I
  76         ;   B=G,
  77             C=H,
  78             E=[A|I]
  79         ),
  80         partition_clauses(M, G, H, I).
  81 is_declaration(A, D) :-
  82         A= (:-B),
  83         (   B=..[chr_constraint, C]
  84         ;   B=..[chr_constraint, C]
  85         ),
  86         conj2list(C, D).
  87 rule(A, D) :-
  88         A= @(C, B), !,
  89         rule(B, yes(C), D).
  90 rule(A, B) :-
  91         rule(A, no, B).
  92 rule(A, H, D) :-
  93         A=pragma(B, C), !,
  94         is_rule(B, E, F),
  95         conj2list(C, G),
  96         D=pragma(E, F, G, H).
  97 rule(A, E, B) :-
  98         is_rule(A, C, D),
  99         B=pragma(C, D, [], E).
 100 is_rule(A, G, D) :-
 101         A= ==>(B, F), !,
 102         conj2list(B, C),
 103         get_ids(C, E, H),
 104         D=ids([], E),
 105         (   F= (I'|'J)
 106         ->  G=rule([], H, I, J)
 107         ;   G=rule([], H, true, F)
 108         ).
 109 is_rule(A, R, M) :-
 110         A= <=>(G, B), !,
 111         (   B= (C'|'D)
 112         ->  E=C,
 113             F=D
 114         ;   E=true,
 115             F=B
 116         ),
 117         (   G= \(H, I)
 118         ->  conj2list(H, J),
 119             conj2list(I, K),
 120             get_ids(J, O, P, 0, L),
 121             get_ids(K, N, Q, L, _),
 122             M=ids(N, O)
 123         ;   conj2list(G, K),
 124             P=[],
 125             get_ids(K, N, Q),
 126             M=ids(N, [])
 127         ),
 128         R=rule(Q, P, E, F).
 129 get_ids(A, B, C) :-
 130         get_ids(A, B, C, 0, _).
 131 get_ids([], [], [], A, A).
 132 get_ids([B|D], [A|E], [C|F], A, H) :-
 133         (   B= #(C, A)
 134         ->  true
 135         ;   C=B
 136         ),
 137         G is A+1,
 138         get_ids(D, E, F, G, H).
 139 is_module_declaration((:-module(A)), A).
 140 is_module_declaration((:-module(A, _)), A).
 141 check_rules(A, B) :-
 142         check_rules(A, B, 1).
 143 check_rules([], _, _).
 144 check_rules([A|D], B, C) :-
 145         check_rule(A, B, C),
 146         E is C+1,
 147         check_rules(D, B, E).
 148 check_rule(A, F, G) :-
 149         A=pragma(B, _, H, _),
 150         B=rule(C, D, _, _),
 151         append(C, D, E),
 152         check_head_constraints(E, F, A, G),
 153         check_pragmas(H, A, G).
 154 check_head_constraints([], _, _, _).
 155 check_head_constraints([A|E], D, F, G) :-
 156         functor(A, B, C),
 157         (   member(B/C, D)
 158         ->  check_head_constraints(E, D, F, G)
 159         ;   format('CHR compiler ERROR: Undeclared constraint ~w in head of ~@.\n', [B/C, format_rule(F, G)]),
 160             format('    `--> Constraint should be on of ~w.\n', [D]),
 161             fail
 162         ).
 163 check_pragmas([], _, _).
 164 check_pragmas([A|D], B, C) :-
 165         check_pragma(A, B, C),
 166         check_pragmas(D, B, C).
 167 check_pragma(A, B, C) :-
 168         var(A), !,
 169         format('CHR compiler ERROR: invalid pragma ~w in ~@.\n', [A, format_rule(B, C)]),
 170         format('    `--> Pragma should not be a variable!\n', []),
 171         fail.
 172 check_pragma(passive(B), A, E) :- !,
 173         A=pragma(_, ids(C, D), _, _),
 174         (   memberchk_eq(B, C)
 175         ->  true
 176         ;   memberchk_eq(B, D)
 177         ->  true
 178         ;   format('CHR compiler ERROR: invalid identifier ~w in pragma passive in ~@.\n', [B, format_rule(A, E)]),
 179             fail
 180         ).
 181 check_pragma(A, B, C) :-
 182         A=unique(_, _), !,
 183         format('CHR compiler WARNING: undocumented pragma ~w in ~@.\n', [A, format_rule(B, C)]),
 184         format('    `--> Only use this pragma if you know what you are doing.\n', []).
 185 check_pragma(A, B, C) :-
 186         A=already_in_heads, !,
 187         format('CHR compiler WARNING: currently unsupported pragma ~w in ~@.\n', [A, format_rule(B, C)]),
 188         format('    `--> Pragma is ignored. Termination and correctness may be affected \n', []).
 189 check_pragma(A, B, C) :-
 190         A=already_in_head(_), !,
 191         format('CHR compiler WARNING: currently unsupported pragma ~w in ~@.\n', [A, format_rule(B, C)]),
 192         format('    `--> Pragma is ignored. Termination and correctness may be affected \n', []).
 193 check_pragma(A, B, C) :-
 194         format('CHR compiler ERROR: invalid pragma ~w in ~@.\n', [A, format_rule(B, C)]),
 195         format('    `--> Pragma should be one of passive/1!\n', []),
 196         fail.
 197 format_rule(A, D) :-
 198         A=pragma(_, _, _, B),
 199         (   B=yes(C)
 200         ->  write('rule '),
 201             write(C)
 202         ;   write('rule number '),
 203             write(D)
 204         ).
 205 handle_option(A, B) :-
 206         var(A), !,
 207         format('CHR compiler ERROR: ~w.\n', [option(A, B)]),
 208         format('    `--> First argument should be an atom, not a variable.\n', []),
 209         fail.
 210 handle_option(B, A) :-
 211         var(A), !,
 212         format('CHR compiler ERROR: ~w.\n', [option(B, A)]),
 213         format('    `--> Second argument should be a nonvariable.\n', []),
 214         fail.
 215 handle_option(A, B) :-
 216         option_definition(A, B, C), !,
 217         set_chr_pp_flags(C).
 218 handle_option(A, _) :-
 219         \+option_definition(A, _, _), !.
 220 handle_option(A, C) :-
 221         findall(B, option_definition(A, B, _), D),
 222         format('CHR compiler ERROR: ~w.\n', [option(A, C)]),
 223         format('    `--> Invalid value ~w: should be one of ~w.\n', [C, D]),
 224         fail.
 225 option_definition(optimize, experimental, A) :-
 226         A=[unique_analyse_optimise-on, check_unnecessary_active-full, reorder_heads-on, set_semantics_rule-on, check_attachments-on, guard_via_reschedule-on].
 227 option_definition(optimize, full, A) :-
 228         A=[unique_analyse_optimise-on, check_unnecessary_active-full, reorder_heads-on, set_semantics_rule-on, check_attachments-on, guard_via_reschedule-on].
 229 option_definition(optimize, sicstus, A) :-
 230         A=[unique_analyse_optimise-off, check_unnecessary_active-simplification, reorder_heads-off, set_semantics_rule-off, check_attachments-off, guard_via_reschedule-off].
 231 option_definition(optimize, off, A) :-
 232         A=[unique_analyse_optimise-off, check_unnecessary_active-off, reorder_heads-off, set_semantics_rule-off, check_attachments-off, guard_via_reschedule-off].
 233 option_definition(debug, off, A) :-
 234         A=[debugable-off].
 235 option_definition(debug, on, A) :-
 236         A=[debugable-on].
 237 option_definition(check_guard_bindings, on, A) :-
 238         A=[guard_locks-on].
 239 option_definition(check_guard_bindings, off, A) :-
 240         A=[guard_locks-off].
 241 init_chr_pp_flags :-
 242         chr_pp_flag_definition(A, [B|_]),
 243         set_chr_pp_flag(A, B),
 244         fail.
 245 init_chr_pp_flags.
 246 set_chr_pp_flags([]).
 247 set_chr_pp_flags([A-B|C]) :-
 248         set_chr_pp_flag(A, B),
 249         set_chr_pp_flags(C).
 250 set_chr_pp_flag(A, C) :-
 251         atomic_concat('$chr_pp_', A, B),
 252         nb_setval(B, C).
 253 chr_pp_flag_definition(unique_analyse_optimise, [on, off]).
 254 chr_pp_flag_definition(check_unnecessary_active, [full, simplification, off]).
 255 chr_pp_flag_definition(reorder_heads, [on, off]).
 256 chr_pp_flag_definition(set_semantics_rule, [on, off]).
 257 chr_pp_flag_definition(guard_via_reschedule, [on, off]).
 258 chr_pp_flag_definition(guard_locks, [on, off]).
 259 chr_pp_flag_definition(check_attachments, [on, off]).
 260 chr_pp_flag_definition(debugable, [off, on]).
 261 chr_pp_flag(A, D) :-
 262         atomic_concat('$chr_pp_', A, B),
 263         nb_getval(B, C),
 264         (   C==[]
 265         ->  chr_pp_flag_definition(A, [D|_])
 266         ;   C=D
 267         ).
 268 generate_attach_detach_a_constraint_all([], []).
 269 generate_attach_detach_a_constraint_all([A|D], F) :-
 270         (   is_attached(A)
 271         ->  generate_attach_a_constraint(A, B),
 272             generate_detach_a_constraint(A, C)
 273         ;   B=[],
 274             C=[]
 275         ),
 276         generate_attach_detach_a_constraint_all(D, E),
 277         append([B, C, E], F).
 278 generate_attach_a_constraint(A, [B, D]) :-
 279         generate_attach_a_constraint_empty_list(A, B),
 280         get_max_constraint_index(C),
 281         (   C==1
 282         ->  generate_attach_a_constraint_1_1(A, D)
 283         ;   generate_attach_a_constraint_t_p(A, D)
 284         ).
 285 generate_attach_a_constraint_empty_list(A/B, E) :-
 286         atom_concat_list([attach_, A, /, B], C),
 287         D=[[], _],
 288         F=..[C|D],
 289         E= (F:-true).
 290 generate_attach_a_constraint_1_1(A/B, L) :-
 291         atom_concat_list([attach_, A, /, B], C),
 292         D=[[G|E], F],
 293         M=..[C|D],
 294         K=..[C, E, F],
 295         get_target_module(H),
 296         N= ((get_attr(G, H, I)->J=[F|I], put_attr(G, H, J);put_attr(G, H, [F])), K),
 297         L= (M:-N).
 298 generate_attach_a_constraint_t_p(A/B, Z) :-
 299         atom_concat_list([attach_, A, /, B], C),
 300         D=[[Q|E], F],
 301         A1=..[C|D],
 302         Y=..[C, E, F],
 303         get_constraint_index(A/B, G),
 304         or_pattern(G, P),
 305         get_max_constraint_index(H),
 306         make_attr(H, K, I, T),
 307         nth1(G, I, J),
 308         substitute(J, I, [F|J], L),
 309         make_attr(H, K, L, U),
 310         substitute(J, I, [F], M),
 311         make_attr(H, V, M, W),
 312         copy_term_nat(I, N),
 313         nth1(G, N, [F]),
 314         chr_delete(N, [F], O),
 315         set_elems(O, []),
 316         make_attr(H, P, N, X),
 317         get_target_module(R),
 318         B1= ((get_attr(Q, R, S)->S=T, (K/\P=:=P->put_attr(Q, R, U);V is K\/P, put_attr(Q, R, W));put_attr(Q, R, X)), Y),
 319         Z= (A1:-B1).
 320 generate_detach_a_constraint(A, [B, D]) :-
 321         generate_detach_a_constraint_empty_list(A, B),
 322         get_max_constraint_index(C),
 323         (   C==1
 324         ->  generate_detach_a_constraint_1_1(A, D)
 325         ;   generate_detach_a_constraint_t_p(A, D)
 326         ).
 327 generate_detach_a_constraint_empty_list(A/B, E) :-
 328         atom_concat_list([detach_, A, /, B], C),
 329         D=[[], _],
 330         F=..[C|D],
 331         E= (F:-true).
 332 generate_detach_a_constraint_1_1(A/B, L) :-
 333         atom_concat_list([detach_, A, /, B], C),
 334         D=[[G|E], F],
 335         M=..[C|D],
 336         K=..[C, E, F],
 337         get_target_module(H),
 338         N= ((get_attr(G, H, I)->'chr sbag_del_element'(I, F, J), (J==[]->del_attr(G, H);put_attr(G, H, J));true), K),
 339         L= (M:-N).
 340 generate_detach_a_constraint_t_p(A/B, Y) :-
 341         atom_concat_list([detach_, A, /, B], C),
 342         D=[[N|E], F],
 343         Z=..[C|D],
 344         X=..[C, E, F],
 345         get_constraint_index(A/B, G),
 346         or_pattern(G, R),
 347         and_pattern(G, U),
 348         get_max_constraint_index(H),
 349         make_attr(H, L, I, Q),
 350         nth1(G, I, J),
 351         substitute(J, I, [], K),
 352         make_attr(H, T, K, V),
 353         substitute(J, I, S, M),
 354         make_attr(H, L, M, W),
 355         get_target_module(O),
 356         A1= ((get_attr(N, O, P)->P=Q, (L/\R=:=R->'chr sbag_del_element'(J, F, S), (S==[]->T is L/\U, (T==0->del_attr(N, O);put_attr(N, O, V));put_attr(N, O, W));true);true), X),
 357         Y= (Z:-A1).
 358 generate_attach_increment([A, C]) :-
 359         generate_attach_increment_empty(A),
 360         get_max_constraint_index(B),
 361         (   B==1
 362         ->  generate_attach_increment_one(C)
 363         ;   generate_attach_increment_many(B, C)
 364         ).
 365 generate_attach_increment_empty((attach_increment([], _):-true)).
 366 generate_attach_increment_one(H) :-
 367         I=attach_increment([A|G], D),
 368         get_target_module(B),
 369         J= ('chr not_locked'(A), (get_attr(A, B, C)->sort(C, E), merge(D, E, F), put_attr(A, B, F);put_attr(A, B, D)), attach_increment(G, D)),
 370         H= (I:-J).
 371 generate_attach_increment_many(A, Z) :-
 372         make_attr(A, V, C, B),
 373         make_attr(A, W, D, S),
 374         A1=attach_increment([P|Y], B),
 375         bagof(G, E^F^H^I^ (member2(C, D, E-F), G= (sort(F, H), 'chr merge_attributes'(E, H, I))), J),
 376         list2conj(J, T),
 377         bagof(N, K^L^M^member((K, 'chr merge_attributes'(L, M, N)), J), O),
 378         make_attr(A, U, O, X),
 379         get_target_module(Q),
 380         B1= ('chr not_locked'(P), (get_attr(P, Q, R)->R=S, T, U is V\/W, put_attr(P, Q, X);put_attr(P, Q, B)), attach_increment(Y, B)),
 381         Z= (A1:-B1).
 382 generate_attr_unify_hook([B]) :-
 383         get_max_constraint_index(A),
 384         (   A==1
 385         ->  generate_attr_unify_hook_one(B)
 386         ;   generate_attr_unify_hook_many(A, B)
 387         ).
 388 generate_attr_unify_hook_one(K) :-
 389         L=A:attr_unify_hook(B, C),
 390         get_target_module(A),
 391         make_run_suspensions(G, H),
 392         make_run_suspensions(B, J),
 393         M= (sort(B, E), (var(C)-> (get_attr(C, A, D)->true;D=[]), sort(D, F), 'chr merge_attributes'(E, F, G), put_attr(C, A, G), H; (compound(C)->term_variables(C, I), attach_increment(I, E);true), J)),
 394         K= (L:-M).
 395 generate_attr_unify_hook_many(A, F1) :-
 396         make_attr(A, Q, C, R),
 397         make_attr(A, Z, H, W),
 398         bagof(D, B^E^ (member(B, C), D=sort(B, E)), F),
 399         list2conj(F, T),
 400         bagof(E, B^member(sort(B, E), F), G),
 401         bagof(K, I^J^L^M^ (member2(G, H, I-J), K= (sort(J, L), 'chr merge_attributes'(I, L, M))), O),
 402         bagof(M, I^L^N^member((N, 'chr merge_attributes'(I, L, M)), O), P),
 403         list2conj(O, X),
 404         make_attr(A, Y, P, A1),
 405         make_attr(A, Q, G, C1),
 406         G1=S:attr_unify_hook(R, U),
 407         get_target_module(S),
 408         make_run_suspensions_loop(P, B1),
 409         make_run_suspensions_loop(G, D1),
 410         H1= (T, (var(U)-> (get_attr(U, S, V)->V=W, X, Y is Q\/Z, put_attr(U, S, A1), B1;put_attr(U, S, C1), D1); (compound(U)->term_variables(U, E1), attach_increment(E1, C1);true), D1)),
 411         F1= (G1:-H1).
 412 make_run_suspensions(B, A) :-
 413         (   chr_pp_flag(debugable, on)
 414         ->  A='chr run_suspensions_d'(B)
 415         ;   A='chr run_suspensions'(B)
 416         ).
 417 make_run_suspensions_loop(B, A) :-
 418         (   chr_pp_flag(debugable, on)
 419         ->  A='chr run_suspensions_loop_d'(B)
 420         ;   A='chr run_suspensions_loop'(B)
 421         ).
 422 check_attachments(A) :-
 423         (   chr_pp_flag(check_attachments, on)
 424         ->  check_attachments_(A)
 425         ;   true
 426         ).
 427 check_attachments_([]).
 428 check_attachments_([A|B]) :-
 429         check_attachment(A),
 430         check_attachments_(B).
 431 check_attachment(A) :-
 432         A=pragma(B, _, _, _),
 433         B=rule(C, D, E, F),
 434         check_attachment_heads1(C, C, D, E),
 435         check_attachment_heads2(D, C, F).
 436 check_attachment_heads1([], _, _, _).
 437 check_attachment_heads1([A|H], B, C, D) :-
 438         functor(A, F, G),
 439         (   B==[A],
 440             C==[],
 441             D==true,
 442             A=..[_|E],
 443             no_matching(E, [])
 444         ->  attached(F/G, no)
 445         ;   attached(F/G, maybe)
 446         ),
 447         check_attachment_heads1(H, B, C, D).
 448 no_matching([], _).
 449 no_matching([A|C], B) :-
 450         var(A),
 451         \+memberchk_eq(A, B),
 452         no_matching(C, [A|B]).
 453 check_attachment_heads2([], _, _).
 454 check_attachment_heads2([A|F], B, C) :-
 455         functor(A, D, E),
 456         (   B\==[],
 457             C==true
 458         ->  attached(D/E, maybe)
 459         ;   attached(D/E, yes)
 460         ),
 461         check_attachment_heads2(F, B, C).
 462 all_attached([]).
 463 all_attached([A|D]) :-
 464         functor(A, B, C),
 465         is_attached(B/C),
 466         all_attached(D).
 467 set_constraint_indices([], A) :-
 468         B is A-1,
 469         max_constraint_index(B).
 470 set_constraint_indices([A|C], B) :-
 471         (   is_attached(A)
 472         ->  constraint_index(A, B),
 473             D is B+1,
 474             set_constraint_indices(C, D)
 475         ;   set_constraint_indices(C, B)
 476         ).
 477 constraints_code(A, B, D) :-
 478         post_constraints(A, 1),
 479         constraints_code1(1, B, C, []),
 480         clean_clauses(C, D).
 481 post_constraints([], A) :-
 482         B is A-1,
 483         constraint_count(B).
 484 post_constraints([A/B|D], C) :-
 485         constraint(A/B, C),
 486         E is C+1,
 487         post_constraints(D, E).
 488 constraints_code1(A, E, D, C) :-
 489         constraint_count(B),
 490         (   A>B
 491         ->  C=D
 492         ;   constraint_code(A, E, D, G),
 493             F is A+1,
 494             constraints_code1(F, E, G, C)
 495         ).
 496 constraint_code(A, E, C, J) :-
 497         constraint(B, A),
 498         constraint_prelude(B, D),
 499         C=[D|G],
 500         F=[0],
 501         rules_code(E, 1, A, F, H, G, I),
 502         gen_cond_attach_clause(B, H, I, J).
 503 constraint_prelude(B/A, E) :-
 504         vars_susp(A, C, I, D),
 505         F=..[B|C],
 506         build_head(B, A, [0], D, H),
 507         get_target_module(G),
 508         (   chr_pp_flag(debugable, on)
 509         ->  E= (F:-'chr allocate_constraint'(G:H, I, B, C), ('chr debug_event'(call(I)), H;'chr debug_event'(fail(I)), !, fail), ('chr debug_event'(exit(I));'chr debug_event'(redo(I)), fail))
 510         ;   E= (F:-H)
 511         ).
 512 gen_cond_attach_clause(A/B, C, K, M) :-
 513         (   is_attached(A/B)
 514         ->  (   C==[0]
 515             ->  gen_cond_attach_goal(A/B, G, F, D, E)
 516             ;   vars_susp(B, D, E, F),
 517                 gen_uncond_attach_goal(A/B, E, G, _)
 518             ),
 519             (   chr_pp_flag(debugable, on)
 520             ->  H=..[A|D],
 521                 I='chr debug_event'(insert(#(H, E)))
 522             ;   I=true
 523             ),
 524             build_head(A, B, C, F, J),
 525             L= (J:-I, G),
 526             K=[L|M]
 527         ;   K=M
 528         ).
 529 gen_cond_attach_goal(E/A, G, D, B, C) :-
 530         vars_susp(A, B, C, D),
 531         build_head(E, A, [0], D, J),
 532         atom_concat_list([attach_, E, /, A], F),
 533         K=..[F, H, C],
 534         get_target_module(I),
 535         G= ((var(C)->'chr insert_constraint_internal'(H, C, I:J, E, B);'chr activate_constraint'(H, C, _)), K).
 536 gen_uncond_attach_goal(A/B, D, E, G) :-
 537         atom_concat_list([attach_, A, /, B], C),
 538         H=..[C, F, D],
 539         E= ('chr activate_constraint'(F, D, G), H).
 540 rules_code([], _, _, A, A, B, B).
 541 rules_code([A|F], B, C, D, I, E, K) :-
 542         rule_code(A, B, C, D, H, E, J),
 543         G is B+1,
 544         rules_code(F, G, C, H, I, J, K).
 545 rule_code(A, K, F, G, L, H, N) :-
 546         A=pragma(C, B, _, _),
 547         B=ids(E, J),
 548         C=rule(D, I, _, _),
 549         heads1_code(D, [], E, [], A, F, G, H, M),
 550         heads2_code(I, [], J, [], A, K, F, G, L, M, N).
 551 heads1_code([], _, _, _, _, _, _, A, A).
 552 heads1_code([C|J], F, [H|L], M, A, B, P, Q, S) :-
 553         A=pragma(G, _, I, _),
 554         constraint(D/E, B),
 555         (   functor(C, D, E),
 556             \+check_unnecessary_active(C, F, G),
 557             \+memberchk_eq(passive(H), I),
 558             all_attached(J),
 559             all_attached(F),
 560             G=rule(_, K, _, _),
 561             all_attached(K)
 562         ->  append(J, F, N),
 563             append(L, M, O),
 564             head1_code(C, N, O, A, D/E, B, P, Q, R)
 565         ;   Q=R
 566         ),
 567         heads1_code(J, [C|F], L, [H|M], A, B, P, R, S).
 568 head1_code(D, E, F, A, I, _, J, K, L) :-
 569         A=pragma(B, _, _, _),
 570         B=rule(_, C, _, _),
 571         (   C==[]
 572         ->  reorder_heads(D, E, F, G, H),
 573             simplification_code(D, G, H, A, I, J, K, L)
 574         ;   simpagation_head1_code(D, E, F, A, I, J, K, L)
 575         ).
 576 heads2_code([], _, _, _, _, _, _, A, A, B, B).
 577 heads2_code([C|J], F, [H|L], M, A, P, B, R, W, S, X) :-
 578         A=pragma(G, _, I, _),
 579         constraint(D/E, B),
 580         (   functor(C, D, E),
 581             \+check_unnecessary_active(C, F, G),
 582             \+memberchk_eq(passive(H), I),
 583             \+set_semantics_rule(A),
 584             all_attached(J),
 585             all_attached(F),
 586             G=rule(K, _, _, _),
 587             all_attached(K)
 588         ->  append(J, F, N),
 589             append(L, M, O),
 590             length(J, Q),
 591             head2_code(C, N, O, A, P, Q, D/E, R, S, T),
 592             inc_id(R, V),
 593             gen_alloc_inc_clause(D/E, R, T, U)
 594         ;   S=U,
 595             V=R
 596         ),
 597         heads2_code(J, [C|F], L, [H|M], A, P, B, V, W, U, X).
 598 head2_code(D, E, M, A, G, H, I, J, K, L) :-
 599         A=pragma(B, _, _, _),
 600         B=rule(C, _, _, _),
 601         (   C==[]
 602         ->  reorder_heads(D, E, F),
 603             propagation_code(D, F, B, G, H, I, J, K, L)
 604         ;   simpagation_head2_code(D, E, M, A, I, J, K, L)
 605         ).
 606 gen_alloc_inc_clause(B/A, C, K, M) :-
 607         vars_susp(A, F, G, D),
 608         build_head(B, A, C, D, I),
 609         inc_id(C, E),
 610         build_head(B, A, E, D, J),
 611         (   C==[0]
 612         ->  gen_cond_allocation(F, G, B/A, D, H)
 613         ;   H=true
 614         ),
 615         L= (I:-H, J),
 616         K=[L|M].
 617 gen_cond_allocation(H, E, A/B, C, D) :-
 618         build_head(A, B, [0], C, G),
 619         get_target_module(F),
 620         D= (var(E)->'chr allocate_constraint'(F:G, E, A, H);true).
 621 guard_via_reschedule(A, B, C, D) :-
 622         (   chr_pp_flag(guard_via_reschedule, on)
 623         ->  guard_via_reschedule_main(A, B, C, D)
 624         ;   append(A, B, E),
 625             list2conj(E, D)
 626         ).
 627 guard_via_reschedule_main(B, C, A, G) :-
 628         initialize_unit_dictionary(A, D),
 629         build_units(B, C, D, E),
 630         dependency_reorder(E, F),
 631         units2goal(F, G).
 632 units2goal([], true).
 633 units2goal([unit(_, A, _, _)|B], (A, C)) :-
 634         units2goal(B, C).
 635 dependency_reorder(A, B) :-
 636         dependency_reorder(A, [], B).
 637 dependency_reorder([], A, B) :-
 638         reverse(A, B).
 639 dependency_reorder([A|F], C, G) :-
 640         A=unit(_, _, B, D),
 641         (   B==fixed
 642         ->  E=[A|C]
 643         ;   dependency_insert(C, A, D, E)
 644         ),
 645         dependency_reorder(F, E, G).
 646 dependency_insert([], A, _, [A]).
 647 dependency_insert([A|F], E, C, D) :-
 648         A=unit(B, _, _, _),
 649         (   memberchk(B, C)
 650         ->  D=[E, A|F]
 651         ;   D=[A|G],
 652             dependency_insert(F, E, C, G)
 653         ).
 654 build_units(A, D, B, C) :-
 655         build_retrieval_units(A, 1, E, B, F, C, G),
 656         build_guard_units(D, E, F, G).
 657 build_retrieval_units([], A, A, B, B, C, C).
 658 build_retrieval_units([A|G], C, I, D, K, E, M) :-
 659         term_variables(A, B),
 660         update_unit_dictionary(B, C, D, J, [], F),
 661         E=[unit(C, A, movable, F)|L],
 662         H is C+1,
 663         build_retrieval_units2(G, H, I, J, K, L, M).
 664 build_retrieval_units2([], A, A, B, B, C, C).
 665 build_retrieval_units2([A|G], C, I, D, K, E, M) :-
 666         term_variables(A, B),
 667         update_unit_dictionary(B, C, D, J, [], F),
 668         E=[unit(C, A, fixed, F)|L],
 669         H is C+1,
 670         build_retrieval_units(G, H, I, J, K, L, M).
 671 initialize_unit_dictionary(A, C) :-
 672         term_variables(A, B),
 673         pair_all_with(B, 0, C).
 674 update_unit_dictionary([], _, A, A, B, B).
 675 update_unit_dictionary([B|H], D, A, I, E, J) :-
 676         (   lookup_eq(A, B, C)
 677         ->  (   (   C==D
 678                 ;   memberchk(C, E)
 679                 )
 680             ->  F=E
 681             ;   F=[C|E]
 682             ),
 683             G=A
 684         ;   G=[B-D|A],
 685             F=E
 686         ),
 687         update_unit_dictionary(H, D, G, I, F, J).
 688 build_guard_units(A, C, F, B) :-
 689         (   A=[D]
 690         ->  B=[unit(C, D, fixed, [])]
 691         ;   A=[D|H]
 692         ->  term_variables(D, E),
 693             update_unit_dictionary2(E, C, F, J, [], G),
 694             B=[unit(C, D, movable, G)|K],
 695             I is C+1,
 696             build_guard_units(H, I, J, K)
 697         ).
 698 update_unit_dictionary2([], _, A, A, B, B).
 699 update_unit_dictionary2([B|H], D, A, I, E, J) :-
 700         (   lookup_eq(A, B, C)
 701         ->  (   (   C==D
 702                 ;   memberchk(C, E)
 703                 )
 704             ->  F=E
 705             ;   F=[C|E]
 706             ),
 707             G=[B-D|A]
 708         ;   G=[B-D|A],
 709             F=E
 710         ),
 711         update_unit_dictionary2(H, D, G, I, F, J).
 712 unique_analyse_optimise(A, B) :-
 713         (   chr_pp_flag(unique_analyse_optimise, on)
 714         ->  unique_analyse_optimise_main(A, 1, [], B)
 715         ;   B=A
 716         ).
 717 unique_analyse_optimise_main([], _, _, []).
 718 unique_analyse_optimise_main([A|R], B, D, [O|T]) :-
 719         (   discover_unique_pattern(A, B, C)
 720         ->  E=[C|D]
 721         ;   E=D
 722         ),
 723         A=pragma(F, G, N, Q),
 724         F=rule(H, J, _, _),
 725         G=ids(I, K),
 726         apply_unique_patterns_to_constraints(H, I, E, L),
 727         apply_unique_patterns_to_constraints(J, K, E, M),
 728         append([L, M, N], P),
 729         O=pragma(F, G, P, Q),
 730         S is B+1,
 731         unique_analyse_optimise_main(R, S, E, T).
 732 apply_unique_patterns_to_constraints([], _, _, []).
 733 apply_unique_patterns_to_constraints([B|H], [C|I], A, E) :-
 734         (   member(D, A),
 735             apply_unique_pattern(B, C, D, F)
 736         ->  E=[F|G]
 737         ;   E=G
 738         ),
 739         apply_unique_patterns_to_constraints(H, I, A, G).
 740 apply_unique_pattern(B, L, A, K) :-
 741         A=unique(C, E),
 742         subsumes(B, C, F),
 743         (   setof(I, D^G^H^ (member(D, E), lookup_eq(F, D, G), term_variables(G, H), member(I, H)), J)
 744         ->  true
 745         ;   J=[]
 746         ),
 747         K=unique(L, J).
 748 subsumes(A, B, F) :-
 749         empty_ds(C),
 750         subsumes_aux(A, B, C, D),
 751         ds_to_list(D, E),
 752         build_unifier(E, F).
 753 subsumes_aux(B, A, E, F) :-
 754         (   compound(A),
 755             functor(A, C, D)
 756         ->  compound(B),
 757             functor(B, C, D),
 758             subsumes_aux(D, B, A, E, F)
 759         ;   B==A
 760         ->  F=E
 761         ;   var(A),
 762             get_ds(B, E, G)
 763         ->  G==A,
 764             F=E
 765         ;   var(A),
 766             put_ds(B, E, A, F)
 767         ).
 768 subsumes_aux(0, _, _, A, A) :- !.
 769 subsumes_aux(A, B, C, F, I) :-
 770         arg(A, B, D),
 771         arg(A, C, E),
 772         subsumes_aux(D, E, F, H),
 773         G is A-1,
 774         subsumes_aux(G, B, C, H, I).
 775 build_unifier([], []).
 776 build_unifier([B-A|C], [A-B|D]) :-
 777         build_unifier(C, D).
 778 discover_unique_pattern(A, M, L) :-
 779         A=pragma(B, _, G, N),
 780         (   B=rule([C], [D], E, F)
 781         ->  true
 782         ;   B=rule([C, D], [], E, F)
 783         ),
 784         check_unique_constraints(C, D, E, F, G, H),
 785         term_variables(C, I),
 786         select_pragma_unique_variables(H, I, J),
 787         K=unique(C, J),
 788         copy_term_nat(K, L),
 789         (   verbosity_on
 790         ->  format('Found unique pattern ~w in rule ~d~@\n', [L, M, (N=yes(O)->write([58, 32]), write(O);true)])
 791         ;   true
 792         ).
 793 select_pragma_unique_variables([], _, []).
 794 select_pragma_unique_variables([A-B|F], D, C) :-
 795         (   A==B
 796         ->  C=[A|E]
 797         ;   once((
 798                 (   \+memberchk_eq(A, D)
 799                 ;   \+memberchk_eq(B, D)
 800                 )
 801                 )),
 802             C=E
 803         ),
 804         select_pragma_unique_variables(F, D, E).
 805 check_unique_constraints(B, C, E, _, A, D) :-
 806         \+member(passive(_), A),
 807         variable_replacement(B-C, C-B, D),
 808         copy_with_variable_replacement(E, G, D),
 809         negate(E, F),
 810         once(entails(F, G)).
 811 negate(true, fail).
 812 negate(fail, true).
 813 negate(B=<A, A<B).
 814 negate(B>A, A>=B).
 815 negate(B>=A, A>B).
 816 negate(B<A, A=<B).
 817 negate(var(A), nonvar(A)).
 818 negate(nonvar(A), var(A)).
 819 entails(B, A) :-
 820         A==B.
 821 entails(fail, _).
 822 entails(B>D, A>=C) :-
 823         A==B,
 824         C==D.
 825 entails(B<D, A=<C) :-
 826         A==B,
 827         C==D.
 828 entails(ground(B), nonvar(A)) :-
 829         A==B.
 830 entails(compound(B), nonvar(A)) :-
 831         A==B.
 832 entails(atomic(B), nonvar(A)) :-
 833         A==B.
 834 entails(number(B), nonvar(A)) :-
 835         A==B.
 836 entails(atom(B), nonvar(A)) :-
 837         A==B.
 838 check_unnecessary_active(A, B, C) :-
 839         (   chr_pp_flag(check_unnecessary_active, full)
 840         ->  check_unnecessary_active_main(A, B, C)
 841         ;   chr_pp_flag(check_unnecessary_active, simplification),
 842             C=rule(_, [], _, _)
 843         ->  check_unnecessary_active_main(A, B, C)
 844         ;   fail
 845         ).
 846 check_unnecessary_active_main(C, A, D) :-
 847         member(B, A),
 848         variable_replacement(B, C, E),
 849         copy_with_variable_replacement(D, F, E),
 850         identical_rules(D, F), !.
 851 set_semantics_rule(A) :-
 852         (   chr_pp_flag(set_semantics_rule, on)
 853         ->  set_semantics_rule_main(A)
 854         ;   fail
 855         ).
 856 set_semantics_rule_main(A) :-
 857         A=pragma(B, C, E, _),
 858         B=rule([_], [_], true, _),
 859         C=ids([D], [F]),
 860         once(member(unique(D, G), E)),
 861         once(member(unique(F, H), E)),
 862         G==H,
 863         \+memberchk_eq(passive(D), E).
 864 identical_rules(rule(E, H, A, C), rule(G, J, B, D)) :-
 865         A==B,
 866         identical_bodies(C, D),
 867         permutation(E, F),
 868         F==G,
 869         permutation(H, I),
 870         I==J.
 871 identical_bodies(A, B) :-
 872         (   A= (C=E),
 873             B= (D=F)
 874         ->  (   C==D,
 875                 E==F
 876             ;   C==F,
 877                 D==E
 878             ), !
 879         ;   A==B
 880         ).
 881 copy_with_variable_replacement(A, C, B) :-
 882         (   var(A)
 883         ->  (   lookup_eq(B, A, C)
 884             ->  true
 885             ;   A=C
 886             )
 887         ;   functor(A, D, E),
 888             functor(C, D, E),
 889             A=..[_|F],
 890             C=..[_|G],
 891             copy_with_variable_replacement_l(F, G, B)
 892         ).
 893 copy_with_variable_replacement_l([], [], _).
 894 copy_with_variable_replacement_l([A|D], [B|E], C) :-
 895         copy_with_variable_replacement(A, B, C),
 896         copy_with_variable_replacement_l(D, E, C).
 897 variable_replacement(A, B, C) :-
 898         variable_replacement(A, B, [], C).
 899 variable_replacement(A, B, C, E) :-
 900         (   var(A)
 901         ->  var(B),
 902             (   lookup_eq(C, A, D)
 903             ->  D==B,
 904                 E=C
 905             ;   E=[A-B|C]
 906             )
 907         ;   A=..[F|G],
 908             nonvar(B),
 909             B=..[F|H],
 910             variable_replacement_l(G, H, C, E)
 911         ).
 912 variable_replacement_l([], [], A, A).
 913 variable_replacement_l([A|D], [B|E], C, G) :-
 914         variable_replacement(A, B, C, F),
 915         variable_replacement_l(D, E, F, G).
 916 simplification_code(B, H, J, A, D/C, E, E1, G1) :-
 917         A=pragma(O, _, K, _),
 918         head_info(B, C, _, S, F, G),
 919         build_head(D, C, E, F, Q),
 920         head_arg_matches(G, [], R, I),
 921         (   H==[]
 922         ->  M=[],
 923             N=I,
 924             L=[]
 925         ;   rest_heads_retrieval_and_matching(H, J, K, B, L, M, I, N)
 926         ),
 927         guard_body_copies2(O, N, P, D1),
 928         guard_via_reschedule(L, P, Q-R, A1),
 929         gen_uncond_susps_detachments(M, H, B1),
 930         gen_cond_susp_detachment(S, D/C, C1),
 931         (   chr_pp_flag(debugable, on)
 932         ->  O=rule(_, _, T, U),
 933             my_term_copy(T-U, N, _, V-W),
 934             Y='chr debug_event'(try([S|X], [], V, W)),
 935             Z='chr debug_event'(apply([S|X], [], V, W))
 936         ;   Y=true,
 937             Z=true
 938         ),
 939         F1= (Q:-R, A1, Y, !, Z, B1, C1, D1),
 940         E1=[F1|G1].
 941 head_arg_matches(A, B, E, C) :-
 942         head_arg_matches_(A, B, D, C),
 943         list2conj(D, E).
 944 head_arg_matches_([], A, [], A).
 945 head_arg_matches_([A-D|H], B, C, P) :-
 946         (   var(A)
 947         ->  (   lookup_eq(B, A, E)
 948             ->  C=[D==E|G],
 949                 F=B
 950             ;   F=[A-D|B],
 951                 C=G
 952             ),
 953             I=H
 954         ;   atomic(A)
 955         ->  C=[D==A|G],
 956             B=F,
 957             I=H
 958         ;   A=..[_|M],
 959             functor(A, J, K),
 960             functor(L, J, K),
 961             L=..[_|N],
 962             C=[nonvar(D), D=L|G],
 963             pairup(M, N, O),
 964             append(O, H, I),
 965             F=B
 966         ),
 967         head_arg_matches_(I, F, G, P).
 968 rest_heads_retrieval_and_matching(A, B, C, D, E, F, G, H) :-
 969         rest_heads_retrieval_and_matching(A, B, C, D, E, F, G, H, [], [], []).
 970 rest_heads_retrieval_and_matching(A, B, C, F, G, H, I, J, D, E, K) :-
 971         (   A=[_|_]
 972         ->  rest_heads_retrieval_and_matching_n(A, B, C, D, E, F, G, H, I, J, K)
 973         ;   G=[],
 974             H=[],
 975             I=J
 976         ).
 977 rest_heads_retrieval_and_matching_n([], _, _, _, _, _, [], [], A, A, B) :-
 978         instantiate_pattern_goals(B).
 979 rest_heads_retrieval_and_matching_n([A|B1], [W|C1], X, C, Q, B, [F, Z|D1], [P|E1], E, G1, D) :-
 980         passive_head_via(A, [B|C], D, E, F, K, H1),
 981         functor(A, L, G),
 982         head_info(A, G, I, _, _, H),
 983         head_arg_matches(H, E, V, F1),
 984         S=..[suspension, _, R, _, _, _, _|I],
 985         get_max_constraint_index(J),
 986         (   J==1
 987         ->  O=K
 988         ;   get_constraint_index(L/G, M),
 989             make_attr(J, _, N, K),
 990             nth1(M, N, O)
 991         ),
 992         different_from_other_susps(A, P, C, Q, U),
 993         create_get_mutable_ref(active, R, T),
 994         A1= ('chr sbag_member'(P, O), P=S, T, U, V),
 995         (   member(unique(W, Y), X),
 996             check_unique_keys(Y, E)
 997         ->  Z= (A1->true)
 998         ;   Z=A1
 999         ),
1000         rest_heads_retrieval_and_matching_n(B1, C1, X, [A|C], [P|Q], B, D1, E1, F1, G1, H1).
1001 instantiate_pattern_goals([]).
1002 instantiate_pattern_goals([_-attr(C, D, B)|G]) :-
1003         get_max_constraint_index(A),
1004         (   A==1
1005         ->  B=true
1006         ;   make_attr(A, E, _, C),
1007             or_list(D, F), !,
1008             B= (E/\F=:=F)
1009         ),
1010         instantiate_pattern_goals(G).
1011 check_unique_keys([], _).
1012 check_unique_keys([B|C], A) :-
1013         lookup_eq(A, B, _),
1014         check_unique_keys(C, A).
1015 different_from_other_susps(C, G, B, E, J) :-
1016         (   bagof(F, A^ (nth1(A, B, D), \+C\=D, nth1(A, E, H), F= (G\==H)), I)
1017         ->  list2conj(I, J)
1018         ;   J=true
1019         ).
1020 passive_head_via(A, D, I, F, O, K, N) :-
1021         functor(A, B, C),
1022         get_constraint_index(B/C, G),
1023         common_variables(A, D, E),
1024         translate(E, F, H),
1025         or_pattern(G, L),
1026         (   permutation(H, J),
1027             lookup_eq(I, J, attr(K, M, _))
1028         ->  member(L, M), !,
1029             N=I,
1030             O=true
1031         ;   O= (P, Q),
1032             gen_get_mod_constraints(H, P, K),
1033             N=[H-attr(K, [L|_], Q)|I]
1034         ).
1035 common_variables(A, B, E) :-
1036         term_variables(A, C),
1037         term_variables(B, D),
1038         intersect_eq(C, D, E).
1039 gen_get_mod_constraints(A, B, F) :-
1040         get_target_module(D),
1041         (   A==[]
1042         ->  B= ('chr default_store'(C), get_attr(C, D, E), E=F)
1043         ;   (   A=[G]
1044             ->  H='chr via_1'(G, J)
1045             ;   A=[G, I]
1046             ->  H='chr via_2'(G, I, J)
1047             ;   H='chr via'(A, J)
1048             ),
1049             B= (H, get_attr(J, D, E), E=F)
1050         ).
1051 guard_body_copies(A, B, E, C) :-
1052         guard_body_copies2(A, B, D, C),
1053         list2conj(D, E).
1054 guard_body_copies2(A, D, H, W) :-
1055         A=rule(_, _, B, U),
1056         conj2list(B, C),
1057         split_off_simple_guard(C, D, E, F),
1058         my_term_copy(E-F, D, V, G-I),
1059         append(G, [Q], H),
1060         term_variables(F, L),
1061         term_variables(I, M),
1062         (   chr_pp_flag(guard_locks, on),
1063             bagof('chr lock'(J)-'chr unlock'(J), K^ (member(K, L), lookup_eq(D, K, J), memberchk_eq(J, M)), N)
1064         ->  once(pairup(O, P, N))
1065         ;   O=[],
1066             P=[]
1067         ),
1068         list2conj(O, R),
1069         list2conj(P, T),
1070         list2conj(I, S),
1071         Q= (R, S, T),
1072         my_term_copy(U, V, W).
1073 split_off_simple_guard([], _, [], []).
1074 split_off_simple_guard([A|D], B, C, F) :-
1075         (   simple_guard(A, B)
1076         ->  C=[A|E],
1077             split_off_simple_guard(D, B, E, F)
1078         ;   C=[],
1079             F=[A|D]
1080         ).
1081 simple_guard(var(_), _).
1082 simple_guard(nonvar(_), _).
1083 simple_guard(ground(_), _).
1084 simple_guard(number(_), _).
1085 simple_guard(atom(_), _).
1086 simple_guard(integer(_), _).
1087 simple_guard(float(_), _).
1088 simple_guard(_>_, _).
1089 simple_guard(_<_, _).
1090 simple_guard(_=<_, _).
1091 simple_guard(_>=_, _).
1092 simple_guard(_=:=_, _).
1093 simple_guard(_==_, _).
1094 simple_guard(B is _, A) :-
1095         \+lookup_eq(A, B, _).
1096 simple_guard((A, C), B) :-
1097         simple_guard(A, B),
1098         simple_guard(C, B).
1099 simple_guard(\+A, B) :-
1100         simple_guard(A, B).
1101 my_term_copy(A, B, C) :-
1102         my_term_copy(A, B, _, C).
1103 my_term_copy(A, B, D, C) :-
1104         (   var(A)
1105         ->  (   lookup_eq(B, A, C)
1106             ->  D=B
1107             ;   D=[A-C|B]
1108             )
1109         ;   functor(A, E, F),
1110             functor(C, E, F),
1111             A=..[_|G],
1112             C=..[_|H],
1113             my_term_copy_list(G, B, D, H)
1114         ).
1115 my_term_copy_list([], A, A, []).
1116 my_term_copy_list([A|D], B, F, [C|G]) :-
1117         my_term_copy(A, B, E, C),
1118         my_term_copy_list(D, E, F, G).
1119 gen_cond_susp_detachment(B, A, C) :-
1120         (   is_attached(A)
1121         ->  gen_uncond_susp_detachment(B, A, D),
1122             C= (var(B)->true;D)
1123         ;   C=true
1124         ).
1125 gen_uncond_susp_detachment(D, A/B, F) :-
1126         (   is_attached(A/B)
1127         ->  atom_concat_list([detach_, A, /, B], C),
1128             H=..[C, G, D],
1129             (   chr_pp_flag(debugable, on)
1130             ->  E='chr debug_event'(remove(D))
1131             ;   E=true
1132             ),
1133             F= (E, 'chr remove_constraint_internal'(D, G), H)
1134         ;   F=true
1135         ).
1136 gen_uncond_susps_detachments([], [], true).
1137 gen_uncond_susps_detachments([B|F], [A|G], (E, H)) :-
1138         functor(A, C, D),
1139         gen_uncond_susp_detachment(B, C/D, E),
1140         gen_uncond_susps_detachments(F, G, H).
1141 simpagation_head1_code(C, I, K, A, F/D, G, L1, N1) :-
1142         A=pragma(B, ids(_, L), Q, _),
1143         B=rule(_, J, A1, B1),
1144         head_info(C, D, _, Z, H, E),
1145         head_arg_matches(E, [], X, R),
1146         build_head(F, D, G, H, W),
1147         append(I, J, M),
1148         append(K, L, N),
1149         reorder_heads(C, M, N, O, P),
1150         rest_heads_retrieval_and_matching(O, P, Q, C, U, S, R, T),
1151         split_by_ids(P, S, K, Y, C1),
1152         guard_body_copies2(B, T, V, K1),
1153         guard_via_reschedule(U, V, W-X, H1),
1154         gen_uncond_susps_detachments(Y, I, I1),
1155         gen_cond_susp_detachment(Z, F/D, J1),
1156         (   chr_pp_flag(debugable, on)
1157         ->  my_term_copy(A1-B1, T, _, D1-E1),
1158             F1='chr debug_event'(try([Z|Y], C1, D1, E1)),
1159             G1='chr debug_event'(apply([Z|Y], C1, D1, E1))
1160         ;   F1=true,
1161             G1=true
1162         ),
1163         M1= (W:-X, H1, F1, !, G1, I1, J1, K1),
1164         L1=[M1|N1].
1165 split_by_ids([], [], _, [], []).
1166 split_by_ids([A|H], [D|I], B, C, E) :-
1167         (   memberchk_eq(A, B)
1168         ->  C=[D|F],
1169             E=G
1170         ;   C=F,
1171             E=[D|G]
1172         ),
1173         split_by_ids(H, I, B, F, G).
1174 simpagation_head2_code(C, G, P, A, J, K, L, T) :-
1175         A=pragma(B, ids(E, _), Q, _),
1176         B=rule(D, _, H, I),
1177         reorder_heads(C, D, E, [F|N], [M|O]),
1178         simpagation_head2_prelude(C, F, [G, D, H, I], J, K, L, S),
1179         extend_id(K, R),
1180         simpagation_head2_worker(C, F, M, N, O, G, P, B, Q, J, R, S, T).
1181 simpagation_head2_prelude(A, G, T, C/B, D, B1, D1) :-
1182         head_info(A, B, Q, R, E, F),
1183         build_head(C, B, D, E, X),
1184         head_arg_matches(F, [], Y, H),
1185         passive_head_via(G, [A], [], H, Z, K, I),
1186         instantiate_pattern_goals(I),
1187         get_max_constraint_index(J),
1188         (   J==1
1189         ->  P=K
1190         ;   functor(G, L, M),
1191             get_constraint_index(L/M, N),
1192             make_attr(J, _, O, K),
1193             nth1(N, O, P)
1194         ),
1195         (   D==[0]
1196         ->  gen_cond_allocation(Q, R, C/B, E, S)
1197         ;   S=true
1198         ),
1199         extend_id(D, V),
1200         extra_active_delegate_variables(A, T, H, U),
1201         append([P|E], U, W),
1202         build_head(C, B, V, W, A1),
1203         C1= (X:-Y, Z, !, S, A1),
1204         B1=[C1|D1].
1205 extra_active_delegate_variables(A, B, C, E) :-
1206         A=..[_|D],
1207         delegate_variables(A, B, C, D, E).
1208 passive_delegate_variables(B, A, C, D, F) :-
1209         term_variables(A, E),
1210         delegate_variables(B, C, D, E, F).
1211 delegate_variables(A, B, H, F, I) :-
1212         term_variables(A, C),
1213         term_variables(B, D),
1214         intersect_eq(C, D, E),
1215         list_difference_eq(E, F, G),
1216         translate(G, H, I).
1217 simpagation_head2_worker(B, C, K, D, L, E, M, A, N, H, I, J, P) :-
1218         A=rule(_, _, F, G),
1219         simpagation_head2_worker_end(B, [C, D, E, F, G], H, I, J, O),
1220         simpagation_head2_worker_body(B, C, K, D, L, E, M, A, N, H, I, O, P).
1221 simpagation_head2_worker_body(A, E, C2, F, X, G, Y, D, D1, O/B, P, H2, I2) :-
1222         gen_var(K),
1223         gen_var(L),
1224         head_info(A, B, _, R1, M, C),
1225         head_arg_matches(C, [], _, J),
1226         D=rule(_, _, H, I),
1227         extra_active_delegate_variables(A, [E, F, G, H, I], J, N),
1228         append([[K|L]|M], N, Q),
1229         build_head(O, B, P, Q, N1),
1230         functor(E, _, R),
1231         head_info(E, R, T, _, _, S),
1232         head_arg_matches(S, J, P1, E1),
1233         V=..[suspension, _, U, _, _, _, _|T],
1234         create_get_mutable_ref(active, U, W),
1235         O1= (K=V, W),
1236         (   (   F\==[]
1237             ;   G\==[]
1238             )
1239         ->  append(F, G, Z),
1240             append(X, Y, A1),
1241             reorder_heads(E-A, Z, A1, B1, C1),
1242             rest_heads_retrieval_and_matching(B1, C1, D1, [E, A], G1, F1, E1, J1, [E], [K], []),
1243             split_by_ids(C1, F1, X, H1, I1)
1244         ;   G1=[],
1245             H1=[],
1246             I1=[],
1247             J1=E1
1248         ),
1249         gen_uncond_susps_detachments([K|H1], [E|F], F2),
1250         append([L|M], N, K1),
1251         build_head(O, B, P, K1, S1),
1252         append([[]|M], N, L1),
1253         build_head(O, B, P, L1, U1),
1254         guard_body_copies2(D, J1, M1, Q1),
1255         guard_via_reschedule(G1, M1, v(N1, O1, P1), E2),
1256         (   Q1\==true
1257         ->  gen_uncond_attach_goal(O/B, R1, V1, T1),
1258             gen_state_cond_call(R1, B, S1, T1, W1),
1259             gen_state_cond_call(R1, B, U1, T1, X1)
1260         ;   V1=true,
1261             W1=S1,
1262             X1=U1
1263         ),
1264         (   chr_pp_flag(debugable, on)
1265         ->  my_term_copy(H-I, J1, _, Y1-Z1),
1266             A2='chr debug_event'(try([K|H1], [R1|I1], Y1, Z1)),
1267             B2='chr debug_event'(apply([K|H1], [R1|I1], Y1, Z1))
1268         ;   A2=true,
1269             B2=true
1270         ),
1271         (   member(unique(C2, D2), D1),
1272             check_unique_keys(D2, J)
1273         ->  G2= (N1:-O1, P1-> (E2, A2->B2, F2, V1, Q1, X1;U1);S1)
1274         ;   G2= (N1:-O1, P1, E2, A2->B2, F2, V1, Q1, W1;S1)
1275         ),
1276         H2=[G2|I2].
1277 gen_state_cond_call(G, A, K, D, F) :-
1278         length(B, A),
1279         H=..[suspension, _, C, _, E, _, _|B],
1280         create_get_mutable_ref(active, C, I),
1281         create_get_mutable_ref(D, E, J),
1282         F= (G=H, I, J->'chr update_mutable'(inactive, C), K;true).
1283 simpagation_head2_worker_end(A, D, H/B, I, N, P) :-
1284         head_info(A, B, _, _, F, C),
1285         head_arg_matches(C, [], _, E),
1286         extra_active_delegate_variables(A, D, E, G),
1287         append([[]|F], G, J),
1288         build_head(H, B, I, J, L),
1289         next_id(I, K),
1290         build_head(H, B, K, F, M),
1291         O= (L:-M),
1292         N=[O|P].
1293 propagation_code(B, A, C, D, I, E, F, G, H) :-
1294         (   A==[]
1295         ->  propagation_single_headed(B, C, D, E, F, G, H)
1296         ;   propagation_multi_headed(B, A, C, D, I, E, F, G, H)
1297         ).
1298 propagation_single_headed(A, I, Y, C/B, D, D1, F1) :-
1299         head_info(A, B, K, L, E, H),
1300         build_head(C, B, D, E, W),
1301         inc_id(D, F),
1302         build_head(C, B, F, E, G),
1303         O=G,
1304         head_arg_matches(H, [], X, J),
1305         guard_body_copies(I, J, Z, B1),
1306         (   D==[0]
1307         ->  gen_cond_allocation(K, L, C/B, E, M),
1308             N=M
1309         ;   N=true
1310         ),
1311         gen_uncond_attach_goal(C/B, L, A1, P),
1312         gen_state_cond_call(L, B, O, P, C1),
1313         (   chr_pp_flag(debugable, on)
1314         ->  I=rule(_, _, Q, R),
1315             my_term_copy(Q-R, J, _, S-T),
1316             U='chr debug_event'(try([], [L], S, T)),
1317             V='chr debug_event'(apply([], [L], S, T))
1318         ;   U=true,
1319             V=true
1320         ),
1321         E1= (W:-X, N, 'chr novel_production'(L, Y), Z, U, !, V, 'chr extend_history'(L, Y), A1, B1, C1),
1322         D1=[E1|F1].
1323 propagation_multi_headed(B, A, C, I, J, D, E, F, M) :-
1324         A=[H|G],
1325         propagation_prelude(B, A, C, D, E, F, L),
1326         extend_id(E, K),
1327         propagation_nested_code(G, [H, B], C, I, J, D, K, L, M).
1328 propagation_prelude(A, [H|I], G, C/B, D, F1, H1) :-
1329         head_info(A, B, U, V, E, F),
1330         build_head(C, B, D, E, B1),
1331         head_arg_matches(F, [], C1, L),
1332         G=rule(_, _, J, K),
1333         extra_active_delegate_variables(A, [H, I, J, K], L, X),
1334         passive_head_via(H, [A], [], L, D1, O, M),
1335         instantiate_pattern_goals(M),
1336         get_max_constraint_index(N),
1337         (   N==1
1338         ->  T=O
1339         ;   functor(H, P, Q),
1340             make_attr(N, _, S, O),
1341             get_constraint_index(P/Q, R),
1342             nth1(R, S, T)
1343         ),
1344         (   D==[0]
1345         ->  gen_cond_allocation(U, V, C/B, E, W)
1346         ;   W=true
1347         ),
1348         extend_id(D, Y),
1349         append([T|E], X, Z),
1350         build_head(C, B, Y, Z, A1),
1351         E1=A1,
1352         G1= (B1:-C1, D1, !, W, E1),
1353         F1=[G1|H1].
1354 propagation_nested_code([], [A|B], C, G, H, D, E, F, J) :-
1355         propagation_end([A|B], [], C, D, E, F, I),
1356         propagation_body(A, B, C, G, H, D, E, I, J).
1357 propagation_nested_code([B|C], A, D, I, J, E, F, G, M) :-
1358         propagation_end(A, [B|C], D, E, F, G, H),
1359         propagation_accumulator([B|C], A, D, E, F, H, L),
1360         inc_id(F, K),
1361         propagation_nested_code(C, [B|A], D, I, J, E, K, L, M).
1362 propagation_body(C, B, A, G1, B1, N/O, P, W1, Y1) :-
1363         A=rule(_, _, D, E),
1364         get_prop_inner_loop_vars(B, [C, D, E], M, V, Y, W),
1365         gen_var(I),
1366         gen_var(L),
1367         functor(C, _, F),
1368         gen_vars(F, G),
1369         J=..[suspension, _, H, _, _, _, _|G],
1370         create_get_mutable_ref(active, H, K),
1371         M1= (I=J, K),
1372         Q=[[I|L]|M],
1373         build_head(N, O, P, Q, L1),
1374         R=[L|M],
1375         build_head(N, O, P, R, S),
1376         Z=S,
1377         C=..[_|T],
1378         pairup(T, G, U),
1379         head_arg_matches(U, V, O1, X),
1380         different_from_other_susps(C, I, B, W, N1),
1381         guard_body_copies(A, X, S1, U1),
1382         gen_uncond_attach_goal(N/O, Y, T1, A1),
1383         gen_state_cond_call(Y, O, Z, A1, V1),
1384         history_susps(B1, [I|W], Y, [], D1),
1385         bagof('chr novel_production'(C1, E1), (member(C1, D1), E1=P1), F1),
1386         list2conj(F1, R1),
1387         Q1=..[t, G1|D1],
1388         (   chr_pp_flag(debugable, on)
1389         ->  A=rule(_, _, D, E),
1390             my_term_copy(D-E, X, _, H1-I1),
1391             J1='chr debug_event'(try([], [Y, I|W], H1, I1)),
1392             K1='chr debug_event'(apply([], [Y, I|W], H1, I1))
1393         ;   J1=true,
1394             K1=true
1395         ),
1396         X1= (L1:-M1, N1, O1, P1=Q1, R1, S1, J1->K1, 'chr extend_history'(Y, P1), T1, U1, V1;Z),
1397         W1=[X1|Y1].
1398 history_susps(A, B, D, E, F) :-
1399         (   A==0
1400         ->  reverse(B, C),
1401             append(C, [D|E], F)
1402         ;   B=[I|H],
1403             G is A-1,
1404             history_susps(G, H, D, [I|E], F)
1405         ).
1406 get_prop_inner_loop_vars([A], F, I, E, C, []) :- !,
1407         functor(A, _, B),
1408         head_info(A, B, _, C, G, D),
1409         head_arg_matches(D, [], _, E),
1410         extra_active_delegate_variables(A, F, E, H),
1411         append(G, H, I).
1412 get_prop_inner_loop_vars([B|A], C, N, J, D, [G|E]) :-
1413         get_prop_inner_loop_vars(A, [B|C], M, I, D, E),
1414         functor(B, _, F),
1415         gen_var(L),
1416         head_info(B, F, _, G, _, H),
1417         head_arg_matches(H, I, _, J),
1418         passive_delegate_variables(B, A, C, J, K),
1419         append(K, [G, L|M], N).
1420 propagation_end([C|B], D, A, H/I, J, S, U) :-
1421         A=rule(_, _, E, F),
1422         gen_var_susp_list_for(B, [C, D, E, F], _, G, L, O),
1423         K=[[]|G],
1424         build_head(H, I, J, K, Q),
1425         (   J=[0|_]
1426         ->  next_id(J, M),
1427             N=L
1428         ;   dec_id(J, M),
1429             N=[O|L]
1430         ),
1431         build_head(H, I, M, N, P),
1432         R=P,
1433         T= (Q:-R),
1434         S=[T|U].
1435 gen_var_susp_list_for([A], G, F, I, D, C) :- !,
1436         functor(A, _, B),
1437         head_info(A, B, _, C, D, E),
1438         head_arg_matches(E, [], _, F),
1439         extra_active_delegate_variables(A, G, F, H),
1440         append(D, H, I).
1441 gen_var_susp_list_for([B|A], C, I, L, D, E) :-
1442         gen_var_susp_list_for(A, [B|C], H, D, _, _),
1443         functor(B, _, F),
1444         gen_var(E),
1445         head_info(B, F, _, K, _, G),
1446         head_arg_matches(G, H, _, I),
1447         passive_delegate_variables(B, A, C, I, J),
1448         append(J, [K, E|D], L).
1449 propagation_accumulator([D|E], [C|B], A, E1/F1, B1, Q1, S1) :-
1450         A=rule(_, _, F, G),
1451         pre_vars_and_susps(B, [C, D, E, F, G], D1, K, M),
1452         gen_var(C1),
1453         functor(C, _, H),
1454         gen_vars(H, I),
1455         head_info(C, H, I, L, _, J),
1456         head_arg_matches(J, K, R, S),
1457         O=..[suspension, _, N, _, _, _, _|I],
1458         different_from_other_susps(C, L, B, M, Q),
1459         create_get_mutable_ref(active, N, P),
1460         M1= (L=O, P, Q, R),
1461         functor(D, W, X),
1462         passive_head_via(D, [C|B], [], S, N1, V, T),
1463         instantiate_pattern_goals(T),
1464         get_max_constraint_index(U),
1465         (   U==1
1466         ->  A1=V
1467         ;   get_constraint_index(W/X, Y),
1468             make_attr(U, _, Z, V),
1469             nth1(Y, Z, A1)
1470         ),
1471         inc_id(B1, I1),
1472         G1=[[L|C1]|D1],
1473         build_head(E1, F1, B1, G1, L1),
1474         passive_delegate_variables(C, B, [D, E, F, G], S, H1),
1475         append([A1|H1], [L, C1|D1], J1),
1476         build_head(E1, F1, I1, J1, O1),
1477         K1=[C1|D1],
1478         build_head(E1, F1, B1, K1, P1),
1479         R1= (L1:-M1, N1->O1;P1),
1480         Q1=[R1|S1].
1481 pre_vars_and_susps([A], E, H, D, []) :- !,
1482         functor(A, _, B),
1483         head_info(A, B, _, _, F, C),
1484         head_arg_matches(C, [], _, D),
1485         extra_active_delegate_variables(A, E, D, G),
1486         append(F, G, H).
1487 pre_vars_and_susps([B|A], C, M, I, [F|D]) :-
1488         pre_vars_and_susps(A, [B|C], L, H, D),
1489         functor(B, _, E),
1490         gen_var(K),
1491         head_info(B, E, _, F, _, G),
1492         head_arg_matches(G, H, _, I),
1493         passive_delegate_variables(B, A, C, I, J),
1494         append(J, [F, K|L], M).
1495 reorder_heads(A, B, C, D, E) :-
1496         (   chr_pp_flag(reorder_heads, on)
1497         ->  reorder_heads_main(A, B, C, D, E)
1498         ;   D=B,
1499             E=C
1500         ).
1501 reorder_heads_main(A, B, C, E, F) :-
1502         term_variables(A, D),
1503         reorder_heads1(B, C, D, E, F).
1504 reorder_heads1(A, D, E, B, C) :-
1505         (   A==[]
1506         ->  B=[],
1507             C=[]
1508         ;   B=[F|K],
1509             C=[G|L],
1510             select_best_head(A, D, E, F, G, H, I, J),
1511             reorder_heads1(H, I, J, K, L)
1512         ).
1513 select_best_head(C, D, G, J, K, L, M, Q) :-
1514         (   bagof(tuple(H, A, B, E, F), (select2(A, B, C, D, E, F), order_score(A, G, E, H)), I)
1515         ->  true
1516         ;   I=[]
1517         ),
1518         max_go_list(I, tuple(_, J, K, L, M)),
1519         term_variables(J, O),
1520         (   setof(N, (member(N, O), \+memberchk_eq(N, G)), P)
1521         ->  true
1522         ;   P=[]
1523         ),
1524         append(P, G, Q).
1525 reorder_heads(A, B, D) :-
1526         term_variables(A, C),
1527         reorder_heads1(B, C, D).
1528 reorder_heads1(A, C, B) :-
1529         (   A==[]
1530         ->  B=[]
1531         ;   B=[D|G],
1532             select_best_head(A, C, D, E, F),
1533             reorder_heads1(E, F, G)
1534         ).
1535 select_best_head(B, D, G, H, L) :-
1536         (   bagof(tuple(E, A, C), (select(A, B, C), order_score(A, D, C, E)), F)
1537         ->  true
1538         ;   F=[]
1539         ),
1540         max_go_list(F, tuple(_, G, H)),
1541         term_variables(G, J),
1542         (   setof(I, (member(I, J), \+memberchk_eq(I, D)), K)
1543         ->  true
1544         ;   K=[]
1545         ),
1546         append(K, D, L).
1547 order_score(A, D, B, F) :-
1548         term_variables(A, C),
1549         term_variables(B, E),
1550         order_score_vars(C, D, E, 0, F).
1551 order_score_vars([], _, _, A, B) :-
1552         (   A==0
1553         ->  B=99999
1554         ;   B=A
1555         ).
1556 order_score_vars([A|F], B, D, C, G) :-
1557         (   memberchk_eq(A, B)
1558         ->  E is C+1
1559         ;   memberchk_eq(A, D)
1560         ->  E is C+1
1561         ;   E=C
1562         ),
1563         order_score_vars(F, B, D, E, G).
1564 create_get_mutable_ref(C, B, A) :-
1565         A= (B=mutable(C)).
1566 clean_clauses([], []).
1567 clean_clauses([A|C], [B|D]) :-
1568         clean_clause(A, B),
1569         clean_clauses(C, D).
1570 clean_clause(A, D) :-
1571         (   A= (E:-B)
1572         ->  clean_goal(B, C),
1573             (   C==true
1574             ->  D=E
1575             ;   D= (E:-C)
1576             )
1577         ;   D=A
1578         ).
1579 clean_goal(A, B) :-
1580         var(A), !,
1581         B=A.
1582 clean_goal((A, B), D) :- !,
1583         clean_goal(A, C),
1584         clean_goal(B, E),
1585         (   C==true
1586         ->  D=E
1587         ;   E==true
1588         ->  D=C
1589         ;   D= (C, E)
1590         ).
1591 clean_goal((A->C;F), D) :- !,
1592         clean_goal(A, B),
1593         (   B==true
1594         ->  clean_goal(C, E),
1595             D=E
1596         ;   B==fail
1597         ->  clean_goal(F, G),
1598             D=G
1599         ;   clean_goal(C, E),
1600             clean_goal(F, G),
1601             D= (B->E;G)
1602         ).
1603 clean_goal((A;B), D) :- !,
1604         clean_goal(A, C),
1605         clean_goal(B, E),
1606         (   C==fail
1607         ->  D=E
1608         ;   E==fail
1609         ->  D=C
1610         ;   D= (C;E)
1611         ).
1612 clean_goal(once(A), C) :- !,
1613         clean_goal(A, B),
1614         (   B==true
1615         ->  C=true
1616         ;   B==fail
1617         ->  C=fail
1618         ;   C=once(B)
1619         ).
1620 clean_goal((A->C), D) :- !,
1621         clean_goal(A, B),
1622         (   B==true
1623         ->  clean_goal(C, D)
1624         ;   B==fail
1625         ->  D=fail
1626         ;   clean_goal(C, E),
1627             D= (B->E)
1628         ).
1629 clean_goal(A, A).
1630 gen_var(_).
1631 gen_vars(B, A) :-
1632         length(A, B).
1633 head_info(E, A, B, C, D, G) :-
1634         vars_susp(A, B, C, D),
1635         E=..[_|F],
1636         pairup(F, B, G).
1637 inc_id([C|A], [B|A]) :-
1638         B is C+1.
1639 dec_id([C|A], [B|A]) :-
1640         B is C-1.
1641 extend_id(A, [0|A]).
1642 next_id([_, C|A], [B|A]) :-
1643         B is C+1.
1644 build_head(A, B, C, F, D) :-
1645         buildName(A, B, C, E),
1646         D=..[E|F].
1647 buildName(A, C, D, F) :-
1648         atom_concat(A, /, B),
1649         atomic_concat(B, C, E),
1650         buildName_(D, E, F).
1651 buildName_([], A, A).
1652 buildName_([E|A], B, F) :-
1653         buildName_(A, B, C),
1654         atom_concat(C, '__', D),
1655         atomic_concat(D, E, F).
1656 vars_susp(B, A, C, D) :-
1657         length(A, B),
1658         append(A, [C], D).
1659 make_attr(B, D, A, C) :-
1660         length(A, B),
1661         C=..[v, D|A].
1662 or_pattern(A, B) :-
1663         C is A-1,
1664         B is 1<<C.
1665 and_pattern(A, C) :-
1666         B is A-1,
1667         D is 1<<B,
1668         C is-1* (D+1).
1669 conj2list(A, B) :-
1670         conj2list(A, B, []).
1671 conj2list(A, C, F) :-
1672         A= (B, D), !,
1673         conj2list(B, C, E),
1674         conj2list(D, E, F).
1675 conj2list(A, [A|B], B).
1676 list2conj([], true).
1677 list2conj([B], A) :- !,
1678         A=B.
1679 list2conj([A|B], C) :-
1680         (   A==true
1681         ->  list2conj(B, C)
1682         ;   C= (A, D),
1683             list2conj(B, D)
1684         ).
1685 atom_concat_list([A], A) :- !.
1686 atom_concat_list([B|A], D) :-
1687         atom_concat_list(A, C),
1688         atomic_concat(B, C, D).
1689 atomic_concat(A, B, E) :-
1690         make_atom(A, C),
1691         make_atom(B, D),
1692         atom_concat(C, D, E).
1693 make_atom(A, B) :-
1694         (   atom(A)
1695         ->  B=A
1696         ;   number(A)
1697         ->  number_codes(A, C),
1698             atom_codes(B, C)
1699         ).
1700 set_elems([], _).
1701 set_elems([A|B], A) :-
1702         set_elems(B, A).
1703 member2([A|_], [B|_], A-B).
1704 member2([_|A], [_|B], C) :-
1705         member2(A, B, C).
1706 select2(A, B, [A|C], [B|D], C, D).
1707 select2(C, D, [A|E], [B|F], [A|G], [B|H]) :-
1708         select2(C, D, E, F, G, H).
1709 pair_all_with([], _, []).
1710 pair_all_with([A|C], B, [A-B|D]) :-
1711         pair_all_with(C, B, D).
1712 verbosity_on :-
1713         prolog_flag(verbose, A),
1714         A==yes.
1715 'attach_constraint/2'([], _).
1716 'attach_constraint/2'([A|L], D) :-
1717         (   get_attr(A, chr_translate_bootstrap1, B)
1718         ->  B=v(C, E, F, G, H, I, J),
1719             (   C/\1=:=1
1720             ->  put_attr(A, chr_translate_bootstrap1, v(C, [D|E], F, G, H, I, J))
1721             ;   K is C\/1,
1722                 put_attr(A, chr_translate_bootstrap1, v(K, [D], F, G, H, I, J))
1723             )
1724         ;   put_attr(A, chr_translate_bootstrap1, v(1, [D], [], [], [], [], []))
1725         ),
1726         'attach_constraint/2'(L, D).
1727 'detach_constraint/2'([], _).
1728 'detach_constraint/2'([A|M], E) :-
1729         (   get_attr(A, chr_translate_bootstrap1, B)
1730         ->  B=v(C, D, H, I, J, K, L),
1731             (   C/\1=:=1
1732             ->  'chr sbag_del_element'(D, E, F),
1733                 (   F==[]
1734                 ->  G is C/\ -2,
1735                     (   G==0
1736                     ->  del_attr(A, chr_translate_bootstrap1)
1737                     ;   put_attr(A, chr_translate_bootstrap1, v(G, [], H, I, J, K, L))
1738                     )
1739                 ;   put_attr(A, chr_translate_bootstrap1, v(C, F, H, I, J, K, L))
1740                 )
1741             ;   true
1742             )
1743         ;   true
1744         ),
1745         'detach_constraint/2'(M, E).
1746 'attach_constraint_count/1'([], _).
1747 'attach_constraint_count/1'([A|L], E) :-
1748         (   get_attr(A, chr_translate_bootstrap1, B)
1749         ->  B=v(C, D, F, G, H, I, J),
1750             (   C/\2=:=2
1751             ->  put_attr(A, chr_translate_bootstrap1, v(C, D, [E|F], G, H, I, J))
1752             ;   K is C\/2,
1753                 put_attr(A, chr_translate_bootstrap1, v(K, D, [E], G, H, I, J))
1754             )
1755         ;   put_attr(A, chr_translate_bootstrap1, v(2, [], [E], [], [], [], []))
1756         ),
1757         'attach_constraint_count/1'(L, E).
1758 'detach_constraint_count/1'([], _).
1759 'detach_constraint_count/1'([A|M], E) :-
1760         (   get_attr(A, chr_translate_bootstrap1, B)
1761         ->  B=v(C, H, D, I, J, K, L),
1762             (   C/\2=:=2
1763             ->  'chr sbag_del_element'(D, E, F),
1764                 (   F==[]
1765                 ->  G is C/\ -3,
1766                     (   G==0
1767                     ->  del_attr(A, chr_translate_bootstrap1)
1768                     ;   put_attr(A, chr_translate_bootstrap1, v(G, H, [], I, J, K, L))
1769                     )
1770                 ;   put_attr(A, chr_translate_bootstrap1, v(C, H, F, I, J, K, L))
1771                 )
1772             ;   true
1773             )
1774         ;   true
1775         ),
1776         'detach_constraint_count/1'(M, E).
1777 'attach_constraint_index/2'([], _).
1778 'attach_constraint_index/2'([A|L], F) :-
1779         (   get_attr(A, chr_translate_bootstrap1, B)
1780         ->  B=v(C, D, E, G, H, I, J),
1781             (   C/\4=:=4
1782             ->  put_attr(A, chr_translate_bootstrap1, v(C, D, E, [F|G], H, I, J))
1783             ;   K is C\/4,
1784                 put_attr(A, chr_translate_bootstrap1, v(K, D, E, [F], H, I, J))
1785             )
1786         ;   put_attr(A, chr_translate_bootstrap1, v(4, [], [], [F], [], [], []))
1787         ),
1788         'attach_constraint_index/2'(L, F).
1789 'detach_constraint_index/2'([], _).
1790 'detach_constraint_index/2'([A|M], E) :-
1791         (   get_attr(A, chr_translate_bootstrap1, B)
1792         ->  B=v(C, H, I, D, J, K, L),
1793             (   C/\4=:=4
1794             ->  'chr sbag_del_element'(D, E, F),
1795                 (   F==[]
1796                 ->  G is C/\ -5,
1797                     (   G==0
1798                     ->  del_attr(A, chr_translate_bootstrap1)
1799                     ;   put_attr(A, chr_translate_bootstrap1, v(G, H, I, [], J, K, L))
1800                     )
1801                 ;   put_attr(A, chr_translate_bootstrap1, v(C, H, I, F, J, K, L))
1802                 )
1803             ;   true
1804             )
1805         ;   true
1806         ),
1807         'detach_constraint_index/2'(M, E).
1808 'attach_max_constraint_index/1'([], _).
1809 'attach_max_constraint_index/1'([A|L], G) :-
1810         (   get_attr(A, chr_translate_bootstrap1, B)
1811         ->  B=v(C, D, E, F, H, I, J),
1812             (   C/\8=:=8
1813             ->  put_attr(A, chr_translate_bootstrap1, v(C, D, E, F, [G|H], I, J))
1814             ;   K is C\/8,
1815                 put_attr(A, chr_translate_bootstrap1, v(K, D, E, F, [G], I, J))
1816             )
1817         ;   put_attr(A, chr_translate_bootstrap1, v(8, [], [], [], [G], [], []))
1818         ),
1819         'attach_max_constraint_index/1'(L, G).
1820 'detach_max_constraint_index/1'([], _).
1821 'detach_max_constraint_index/1'([A|M], E) :-
1822         (   get_attr(A, chr_translate_bootstrap1, B)
1823         ->  B=v(C, H, I, J, D, K, L),
1824             (   C/\8=:=8
1825             ->  'chr sbag_del_element'(D, E, F),
1826                 (   F==[]
1827                 ->  G is C/\ -9,
1828                     (   G==0
1829                     ->  del_attr(A, chr_translate_bootstrap1)
1830                     ;   put_attr(A, chr_translate_bootstrap1, v(G, H, I, J, [], K, L))
1831                     )
1832                 ;   put_attr(A, chr_translate_bootstrap1, v(C, H, I, J, F, K, L))
1833                 )
1834             ;   true
1835             )
1836         ;   true
1837         ),
1838         'detach_max_constraint_index/1'(M, E).
1839 'attach_target_module/1'([], _).
1840 'attach_target_module/1'([A|L], H) :-
1841         (   get_attr(A, chr_translate_bootstrap1, B)
1842         ->  B=v(C, D, E, F, G, I, J),
1843             (   C/\16=:=16
1844             ->  put_attr(A, chr_translate_bootstrap1, v(C, D, E, F, G, [H|I], J))
1845             ;   K is C\/16,
1846                 put_attr(A, chr_translate_bootstrap1, v(K, D, E, F, G, [H], J))
1847             )
1848         ;   put_attr(A, chr_translate_bootstrap1, v(16, [], [], [], [], [H], []))
1849         ),
1850         'attach_target_module/1'(L, H).
1851 'detach_target_module/1'([], _).
1852 'detach_target_module/1'([A|M], E) :-
1853         (   get_attr(A, chr_translate_bootstrap1, B)
1854         ->  B=v(C, H, I, J, K, D, L),
1855             (   C/\16=:=16
1856             ->  'chr sbag_del_element'(D, E, F),
1857                 (   F==[]
1858                 ->  G is C/\ -17,
1859                     (   G==0
1860                     ->  del_attr(A, chr_translate_bootstrap1)
1861                     ;   put_attr(A, chr_translate_bootstrap1, v(G, H, I, J, K, [], L))
1862                     )
1863                 ;   put_attr(A, chr_translate_bootstrap1, v(C, H, I, J, K, F, L))
1864                 )
1865             ;   true
1866             )
1867         ;   true
1868         ),
1869         'detach_target_module/1'(M, E).
1870 'attach_attached/2'([], _).
1871 'attach_attached/2'([A|L], I) :-
1872         (   get_attr(A, chr_translate_bootstrap1, B)
1873         ->  B=v(C, D, E, F, G, H, J),
1874             (   C/\32=:=32
1875             ->  put_attr(A, chr_translate_bootstrap1, v(C, D, E, F, G, H, [I|J]))
1876             ;   K is C\/32,
1877                 put_attr(A, chr_translate_bootstrap1, v(K, D, E, F, G, H, [I]))
1878             )
1879         ;   put_attr(A, chr_translate_bootstrap1, v(32, [], [], [], [], [], [I]))
1880         ),
1881         'attach_attached/2'(L, I).
1882 'detach_attached/2'([], _).
1883 'detach_attached/2'([A|M], E) :-
1884         (   get_attr(A, chr_translate_bootstrap1, B)
1885         ->  B=v(C, H, I, J, K, L, D),
1886             (   C/\32=:=32
1887             ->  'chr sbag_del_element'(D, E, F),
1888                 (   F==[]
1889                 ->  G is C/\ -33,
1890                     (   G==0
1891                     ->  del_attr(A, chr_translate_bootstrap1)
1892                     ;   put_attr(A, chr_translate_bootstrap1, v(G, H, I, J, K, L, []))
1893                     )
1894                 ;   put_attr(A, chr_translate_bootstrap1, v(C, H, I, J, K, L, F))
1895                 )
1896             ;   true
1897             )
1898         ;   true
1899         ),
1900         'detach_attached/2'(M, E).
1901 attach_increment([], _).
1902 attach_increment([A|D1], v(U, D, G, J, M, P, S)) :-
1903         'chr not_locked'(A),
1904         (   get_attr(A, chr_translate_bootstrap1, B)
1905         ->  B=v(V, C, F, I, L, O, R),
1906             sort(C, E),
1907             'chr merge_attributes'(D, E, X),
1908             sort(F, H),
1909             'chr merge_attributes'(G, H, Y),
1910             sort(I, K),
1911             'chr merge_attributes'(J, K, Z),
1912             sort(L, N),
1913             'chr merge_attributes'(M, N, A1),
1914             sort(O, Q),
1915             'chr merge_attributes'(P, Q, B1),
1916             sort(R, T),
1917             'chr merge_attributes'(S, T, C1),
1918             W is U\/V,
1919             put_attr(A, chr_translate_bootstrap1, v(W, X, Y, Z, A1, B1, C1))
1920         ;   put_attr(A, chr_translate_bootstrap1, v(U, D, G, J, M, P, S))
1921         ),
1922         attach_increment(D1, v(U, D, G, J, M, P, S)).
1923 chr_translate_bootstrap1:attr_unify_hook(v(A1, A, B, C, D, E, F), G) :-
1924         sort(A, J),
1925         sort(B, M),
1926         sort(C, P),
1927         sort(D, S),
1928         sort(E, V),
1929         sort(F, Y),
1930         (   var(G)
1931         ->  (   get_attr(G, chr_translate_bootstrap1, H)
1932             ->  H=v(B1, I, L, O, R, U, X),
1933                 sort(I, K),
1934                 'chr merge_attributes'(J, K, D1),
1935                 sort(L, N),
1936                 'chr merge_attributes'(M, N, E1),
1937                 sort(O, Q),
1938                 'chr merge_attributes'(P, Q, F1),
1939                 sort(R, T),
1940                 'chr merge_attributes'(S, T, G1),
1941                 sort(U, W),
1942                 'chr merge_attributes'(V, W, H1),
1943                 sort(X, Z),
1944                 'chr merge_attributes'(Y, Z, I1),
1945                 C1 is A1\/B1,
1946                 put_attr(G, chr_translate_bootstrap1, v(C1, D1, E1, F1, G1, H1, I1)),
1947                 'chr run_suspensions_loop'([D1, E1, F1, G1, H1, I1])
1948             ;   put_attr(G, chr_translate_bootstrap1, v(A1, J, M, P, S, V, Y)),
1949                 'chr run_suspensions_loop'([J, M, P, S, V, Y])
1950             )
1951         ;   (   compound(G)
1952             ->  term_variables(G, J1),
1953                 attach_increment(J1, v(A1, J, M, P, S, V, Y))
1954             ;   true
1955             ),
1956             'chr run_suspensions_loop'([J, M, P, S, V, Y])
1957         ).
1958 constraint(A, B) :-
1959         'constraint/2__0'(A, B, _).
1960 'constraint/2__0'(A, K, I) :-
1961         'chr via_1'(A, B),
1962         get_attr(B, chr_translate_bootstrap1, C),
1963         C=v(D, E, _, _, _, _, _),
1964         D/\1=:=1,
1965         (   'chr sbag_member'(F, E),
1966             F=suspension(_, G, _, _, _, _, H, L),
1967             G=mutable(active),
1968             H==A
1969         ->  true
1970         ), !,
1971         (   var(I)
1972         ->  true
1973         ;   'chr remove_constraint_internal'(I, J),
1974             'detach_constraint/2'(J, I)
1975         ),
1976         K=L.
1977 'constraint/2__0'(K, A, I) :-
1978         'chr via_1'(A, B),
1979         get_attr(B, chr_translate_bootstrap1, C),
1980         C=v(D, E, _, _, _, _, _),
1981         D/\1=:=1,
1982         'chr sbag_member'(F, E),
1983         F=suspension(_, G, _, _, _, _, L, H),
1984         G=mutable(active),
1985         H==A, !,
1986         (   var(I)
1987         ->  true
1988         ;   'chr remove_constraint_internal'(I, J),
1989             'detach_constraint/2'(J, I)
1990         ),
1991         K=L.
1992 'constraint/2__0'(B, C, A) :-
1993         (   var(A)
1994         ->  'chr insert_constraint_internal'(D, A, chr_translate_bootstrap1:'constraint/2__0'(B, C, A), constraint, [B, C])
1995         ;   'chr activate_constraint'(D, A, _)
1996         ),
1997         'attach_constraint/2'(D, A).
1998 constraint_count(A) :-
1999         'constraint_count/1__0'(A, _).
2000 'constraint_count/1__0'(I, G) :-
2001         'chr default_store'(A),
2002         get_attr(A, chr_translate_bootstrap1, B),
2003         B=v(C, _, D, _, _, _, _),
2004         C/\2=:=2,
2005         'chr sbag_member'(E, D),
2006         E=suspension(_, F, _, _, _, _, J),
2007         F=mutable(active), !,
2008         (   var(G)
2009         ->  true
2010         ;   'chr remove_constraint_internal'(G, H),
2011             'detach_constraint_count/1'(H, G)
2012         ),
2013         I=J.
2014 'constraint_count/1__0'(B, A) :-
2015         (   var(A)
2016         ->  'chr insert_constraint_internal'(C, A, chr_translate_bootstrap1:'constraint_count/1__0'(B, A), constraint_count, [B])
2017         ;   'chr activate_constraint'(C, A, _)
2018         ),
2019         'attach_constraint_count/1'(C, A).
2020 constraint_index(A, B) :-
2021         'constraint_index/2__0'(A, B, _).
2022 'constraint_index/2__0'(B, C, A) :-
2023         (   var(A)
2024         ->  'chr insert_constraint_internal'(D, A, chr_translate_bootstrap1:'constraint_index/2__0'(B, C, A), constraint_index, [B, C])
2025         ;   'chr activate_constraint'(D, A, _)
2026         ),
2027         'attach_constraint_index/2'(D, A).
2028 get_constraint_index(A, B) :-
2029         'get_constraint_index/2__0'(A, B, _).
2030 'get_constraint_index/2__0'(A, I, _) :-
2031         'chr via_1'(A, B),
2032         get_attr(B, chr_translate_bootstrap1, C),
2033         C=v(D, _, _, E, _, _, _),
2034         D/\4=:=4,
2035         'chr sbag_member'(F, E),
2036         F=suspension(_, G, _, _, _, _, H, J),
2037         G=mutable(active),
2038         H==A, !,
2039         I=J.
2040 'get_constraint_index/2__0'(_, _, _) :- !,
2041         fail.
2042 max_constraint_index(A) :-
2043         'max_constraint_index/1__0'(A, _).
2044 'max_constraint_index/1__0'(B, A) :-
2045         (   var(A)
2046         ->  'chr insert_constraint_internal'(C, A, chr_translate_bootstrap1:'max_constraint_index/1__0'(B, A), max_constraint_index, [B])
2047         ;   'chr activate_constraint'(C, A, _)
2048         ),
2049         'attach_max_constraint_index/1'(C, A).
2050 get_max_constraint_index(A) :-
2051         'get_max_constraint_index/1__0'(A, _).
2052 'get_max_constraint_index/1__0'(G, _) :-
2053         'chr default_store'(A),
2054         get_attr(A, chr_translate_bootstrap1, B),
2055         B=v(C, _, _, _, D, _, _),
2056         C/\8=:=8,
2057         'chr sbag_member'(E, D),
2058         E=suspension(_, F, _, _, _, _, H),
2059         F=mutable(active), !,
2060         G=H.
2061 'get_max_constraint_index/1__0'(_, _) :- !,
2062         fail.
2063 target_module(A) :-
2064         'target_module/1__0'(A, _).
2065 'target_module/1__0'(B, A) :-
2066         (   var(A)
2067         ->  'chr insert_constraint_internal'(C, A, chr_translate_bootstrap1:'target_module/1__0'(B, A), target_module, [B])
2068         ;   'chr activate_constraint'(C, A, _)
2069         ),
2070         'attach_target_module/1'(C, A).
2071 get_target_module(A) :-
2072         'get_target_module/1__0'(A, _).
2073 'get_target_module/1__0'(G, _) :-
2074         'chr default_store'(A),
2075         get_attr(A, chr_translate_bootstrap1, B),
2076         B=v(C, _, _, _, _, D, _),
2077         C/\16=:=16,
2078         'chr sbag_member'(E, D),
2079         E=suspension(_, F, _, _, _, _, H),
2080         F=mutable(active), !,
2081         G=H.
2082 'get_target_module/1__0'(A, _) :- !,
2083         A=user.
2084 attached(A, B) :-
2085         'attached/2__0'(A, B, _).
2086 'attached/2__0'(A, _, J) :-
2087         'chr via_1'(A, B),
2088         get_attr(B, chr_translate_bootstrap1, C),
2089         C=v(D, _, _, _, _, _, E),
2090         D/\32=:=32,
2091         'chr sbag_member'(F, E),
2092         F=suspension(_, G, _, _, _, _, H, I),
2093         G=mutable(active),
2094         H==A,
2095         I==yes, !,
2096         (   var(J)
2097         ->  true
2098         ;   'chr remove_constraint_internal'(J, K),
2099             'detach_attached/2'(K, J)
2100         ).
2101 'attached/2__0'(B, A, F) :-
2102         A==yes,
2103         'chr via_1'(B, C),
2104         get_attr(C, chr_translate_bootstrap1, D),
2105         D=v(E, _, _, _, _, _, G),
2106         E/\32=:=32, !,
2107         (   var(F)
2108         ->  'chr allocate_constraint'(chr_translate_bootstrap1:'attached/2__0'(B, A, F), F, attached, [B, A])
2109         ;   true
2110         ),
2111         'attached/2__0__0'(G, B, A, F).
2112 'attached/2__0__0'([], A, B, C) :-
2113         'attached/2__1'(A, B, C).
2114 'attached/2__0__0'([A|F], D, G, H) :-
2115         (   A=suspension(_, B, _, _, _, _, C, _),
2116             B=mutable(active),
2117             C==D
2118         ->  'chr remove_constraint_internal'(A, E),
2119             'detach_attached/2'(E, A),
2120             'attached/2__0__0'(F, D, G, H)
2121         ;   'attached/2__0__0'(F, D, G, H)
2122         ).
2123 'attached/2__0'(B, C, A) :-
2124         (   var(A)
2125         ->  'chr allocate_constraint'(chr_translate_bootstrap1:'attached/2__0'(B, C, A), A, attached, [B, C])
2126         ;   true
2127         ),
2128         'attached/2__1'(B, C, A).
2129 'attached/2__1'(A, _, J) :-
2130         'chr via_1'(A, B),
2131         get_attr(B, chr_translate_bootstrap1, C),
2132         C=v(D, _, _, _, _, _, E),
2133         D/\32=:=32,
2134         'chr sbag_member'(F, E),
2135         F=suspension(_, G, _, _, _, _, H, I),
2136         G=mutable(active),
2137         H==A,
2138         I==no, !,
2139         (   var(J)
2140         ->  true
2141         ;   'chr remove_constraint_internal'(J, K),
2142             'detach_attached/2'(K, J)
2143         ).
2144 'attached/2__1'(B, A, G) :-
2145         A==no,
2146         'chr via_1'(B, C),
2147         get_attr(C, chr_translate_bootstrap1, D),
2148         D=v(E, _, _, _, _, _, F),
2149         E/\32=:=32, !,
2150         'attached/2__1__0'(F, B, A, G).
2151 'attached/2__1__0'([], A, B, C) :-
2152         'attached/2__2'(A, B, C).
2153 'attached/2__1__0'([A|F], D, G, H) :-
2154         (   A=suspension(_, B, _, _, _, _, C, _),
2155             B=mutable(active),
2156             C==D
2157         ->  'chr remove_constraint_internal'(A, E),
2158             'detach_attached/2'(E, A),
2159             'attached/2__1__0'(F, D, G, H)
2160         ;   'attached/2__1__0'(F, D, G, H)
2161         ).
2162 'attached/2__1'(A, B, C) :-
2163         'attached/2__2'(A, B, C).
2164 'attached/2__2'(B, A, K) :-
2165         A==maybe,
2166         'chr via_1'(B, C),
2167         get_attr(C, chr_translate_bootstrap1, D),
2168         D=v(E, _, _, _, _, _, F),
2169         E/\32=:=32,
2170         (   'chr sbag_member'(G, F),
2171             G=suspension(_, H, _, _, _, _, I, J),
2172             H=mutable(active),
2173             I==B,
2174             J==maybe
2175         ->  true
2176         ), !,
2177         (   var(K)
2178         ->  true
2179         ;   'chr remove_constraint_internal'(K, L),
2180             'detach_attached/2'(L, K)
2181         ).
2182 'attached/2__2'(_, _, A) :-
2183         'chr activate_constraint'(B, A, _),
2184         'attach_attached/2'(B, A).
2185 is_attached(A) :-
2186         'is_attached/1__0'(A, _).
2187 'is_attached/1__0'(A, _) :-
2188         'chr via_1'(A, B),
2189         get_attr(B, chr_translate_bootstrap1, C),
2190         C=v(D, _, _, _, _, _, E),
2191         D/\32=:=32,
2192         'chr sbag_member'(F, E),
2193         F=suspension(_, G, _, _, _, _, H, I),
2194         G=mutable(active),
2195         H==A, !,
2196         (   I==no
2197         ->  fail
2198         ;   true
2199         ).
2200 'is_attached/1__0'(_, _) :- !.
2201 chr_clear :-
2202         'chr_clear/0__0'(_).
2203 'chr_clear/0__0'(D) :-
2204         'chr default_store'(A),
2205         get_attr(A, chr_translate_bootstrap1, B),
2206         B=v(C, E, _, _, _, _, _),
2207         C/\1=:=1, !,
2208         (   var(D)
2209         ->  'chr allocate_constraint'(chr_translate_bootstrap1:'chr_clear/0__0'(D), D, chr_clear, [])
2210         ;   true
2211         ),
2212         'chr_clear/0__0__0'(E, D).
2213 'chr_clear/0__0__0'([], A) :-
2214         'chr_clear/0__1'(A).
2215 'chr_clear/0__0__0'([A|D], E) :-
2216         (   A=suspension(_, B, _, _, _, _, _, _),
2217             B=mutable(active)
2218         ->  'chr remove_constraint_internal'(A, C),
2219             'detach_constraint/2'(C, A),
2220             'chr_clear/0__0__0'(D, E)
2221         ;   'chr_clear/0__0__0'(D, E)
2222         ).
2223 'chr_clear/0__0'(A) :-
2224         (   var(A)
2225         ->  'chr allocate_constraint'(chr_translate_bootstrap1:'chr_clear/0__0'(A), A, chr_clear, [])
2226         ;   true
2227         ),
2228         'chr_clear/0__1'(A).
2229 'chr_clear/0__1'(E) :-
2230         'chr default_store'(A),
2231         get_attr(A, chr_translate_bootstrap1, B),
2232         B=v(C, _, D, _, _, _, _),
2233         C/\2=:=2, !,
2234         'chr_clear/0__1__0'(D, E).
2235 'chr_clear/0__1__0'([], A) :-
2236         'chr_clear/0__2'(A).
2237 'chr_clear/0__1__0'([A|D], E) :-
2238         (   A=suspension(_, B, _, _, _, _, _),
2239             B=mutable(active)
2240         ->  'chr remove_constraint_internal'(A, C),
2241             'detach_constraint_count/1'(C, A),
2242             'chr_clear/0__1__0'(D, E)
2243         ;   'chr_clear/0__1__0'(D, E)
2244         ).
2245 'chr_clear/0__1'(A) :-
2246         'chr_clear/0__2'(A).
2247 'chr_clear/0__2'(E) :-
2248         'chr default_store'(A),
2249         get_attr(A, chr_translate_bootstrap1, B),
2250         B=v(C, _, _, D, _, _, _),
2251         C/\4=:=4, !,
2252         'chr_clear/0__2__0'(D, E).
2253 'chr_clear/0__2__0'([], A) :-
2254         'chr_clear/0__3'(A).
2255 'chr_clear/0__2__0'([A|D], E) :-
2256         (   A=suspension(_, B, _, _, _, _, _, _),
2257             B=mutable(active)
2258         ->  'chr remove_constraint_internal'(A, C),
2259             'detach_constraint_index/2'(C, A),
2260             'chr_clear/0__2__0'(D, E)
2261         ;   'chr_clear/0__2__0'(D, E)
2262         ).
2263 'chr_clear/0__2'(A) :-
2264         'chr_clear/0__3'(A).
2265 'chr_clear/0__3'(E) :-
2266         'chr default_store'(A),
2267         get_attr(A, chr_translate_bootstrap1, B),
2268         B=v(C, _, _, _, D, _, _),
2269         C/\8=:=8, !,
2270         'chr_clear/0__3__0'(D, E).
2271 'chr_clear/0__3__0'([], A) :-
2272         'chr_clear/0__4'(A).
2273 'chr_clear/0__3__0'([A|D], E) :-
2274         (   A=suspension(_, B, _, _, _, _, _),
2275             B=mutable(active)
2276         ->  'chr remove_constraint_internal'(A, C),
2277             'detach_max_constraint_index/1'(C, A),
2278             'chr_clear/0__3__0'(D, E)
2279         ;   'chr_clear/0__3__0'(D, E)
2280         ).
2281 'chr_clear/0__3'(A) :-
2282         'chr_clear/0__4'(A).
2283 'chr_clear/0__4'(E) :-
2284         'chr default_store'(A),
2285         get_attr(A, chr_translate_bootstrap1, B),
2286         B=v(C, _, _, _, _, D, _),
2287         C/\16=:=16, !,
2288         'chr_clear/0__4__0'(D, E).
2289 'chr_clear/0__4__0'([], A) :-
2290         'chr_clear/0__5'(A).
2291 'chr_clear/0__4__0'([A|D], E) :-
2292         (   A=suspension(_, B, _, _, _, _, _),
2293             B=mutable(active)
2294         ->  'chr remove_constraint_internal'(A, C),
2295             'detach_target_module/1'(C, A),
2296             'chr_clear/0__4__0'(D, E)
2297         ;   'chr_clear/0__4__0'(D, E)
2298         ).
2299 'chr_clear/0__4'(A) :-
2300         'chr_clear/0__5'(A).
2301 'chr_clear/0__5'(E) :-
2302         'chr default_store'(A),
2303         get_attr(A, chr_translate_bootstrap1, B),
2304         B=v(C, _, _, _, _, _, D),
2305         C/\32=:=32, !,
2306         'chr_clear/0__5__0'(D, E).
2307 'chr_clear/0__5__0'([], A) :-
2308         'chr_clear/0__6'(A).
2309 'chr_clear/0__5__0'([A|D], E) :-
2310         (   A=suspension(_, B, _, _, _, _, _, _),
2311             B=mutable(active)
2312         ->  'chr remove_constraint_internal'(A, C),
2313             'detach_attached/2'(C, A),
2314             'chr_clear/0__5__0'(D, E)
2315         ;   'chr_clear/0__5__0'(D, E)
2316         ).
2317 'chr_clear/0__5'(A) :-
2318         'chr_clear/0__6'(A).
2319 'chr_clear/0__6'(_) :- !.