yap-6.3/CHR/chr.yap

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  Constraint Handling Rules			      version 2.2 %
%								  %
%  (c) Copyright 1996-98					  %
%  LMU, Muenchen						  %
%								  %
%  File:   chr.pl						  %
%  Author: Christian Holzbaur		christian@ai.univie.ac.at %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%
% The CHR runtime system,
% the constraint store.
%
% Two functions: a) storage b) reactivation triggered by bindings
%
% Reactivation is symmetric: if two variables with suspensions
% are unified, both suspensions run. (Both variables got more
% constrained)
%
% *** Sequence of wakeups determines termination of handler leq ***
%
% Another sequence that could matter is the one
% generated by the iterators
%
% Layout:
%
%	   suspension(Id,State,Closure,Generation,PropagationHistory,F|Args)
%
%   Id is 1st to allow for direct comparisons (sort) and avoids
%   unifiability if the Id is nonvar.
%   F is the constraint functor
%
%

:- module( chr,
	[
	  find_constraint/2,
	  find_constraint/3,
	  findall_constraints/2,
	  findall_constraints/3,
	  remove_constraint/1,
	  current_handler/2,
	  current_constraint/2,
	  unconstrained/1,
	  notify_constrained/1,

	  chr_trace/0, chr_notrace/0,
	  chr_debug/0, chr_nodebug/0, chr_debugging/0,
	  chr_leash/1, chr_spy/1, chr_nospy/1
      ]).

:- use_module( library('chr/getval')).

:- use_module( library(lists),
	[
	  append/3,
	  member/2,
	  is_list/1,
	  nth/3,
	  select/3
	]).

:- use_module( library(terms),
	[
	  term_variables/2,
	  subsumes_chk/2,
	  subsumes/2
	]).

:- use_module( library(assoc),			% propagation history
	[
	  empty_assoc/1,
	  put_assoc/4,
	  get_assoc/3,
	  assoc_to_list/2
      ]).

:- use_module(library('chr/sbag')).   % link to sbag_l.pl or sbag_a.pl
:- use_module(library('chr/chrcmp')).
:- use_module(library('chr/trace')).

:- use_module(library(atts)).

:- attribute locked/0, exposed/1, dbg_state/1.

%
% Problem with cyclic structures:
%   error reporters seem to use write ...
%
:- multifile
	user:portray/1,
	user:portray_message/2,
	user:goal_expansion/3.

:- dynamic
	user:portray/1,
	user:portray_message/2,
	user:goal_expansion/3.

%
user:portray( Susp) :-
	Susp =.. [suspension,Id,Mref,_,_,_,_|_],
	nonvar( Mref),
	!,
	write('<c'), write(Id), write('>').	% (c)onstraint
%
user:portray( '$want_duplicates'(_,Term)) :- !, % cf. attribute_goal/2
	prolog_flag( toplevel_print_options, Options),
	write_term( Term, Options).

:- initialization
	setval( id, 0).		% counter for portray/debugger

%
user:portray_message( error, chr(multiple_handlers(Old,New,Module))) :- !,
	format( user_error, '{CHR ERROR: registering ~p, module ~p already hosts ~p}~n',
	  [New,Module,Old]).

% -----------------------------------------------------------------

%
% *** MACROS ***
%
%
user:goal_expansion( lock_some(L),		 chr, Exp) :- is_list(L),
	unravel( L, lock, Exp).
user:goal_expansion( unlock_some(L),		 chr, Exp) :- is_list(L),
	unravel( L, unlock, Exp).
user:goal_expansion( via([],V), 		 chr, global_term_ref_1(V)).
user:goal_expansion( via([X],V),		 chr, via_1(X,V)).
user:goal_expansion( via([X,Y],V),		 chr, via_2(X,Y,V)).
user:goal_expansion( via([X,Y,Z],V),		 chr, via_3(X,Y,Z,V)).
user:goal_expansion( load_args(S,State,Args),	 chr, Exp) :-
	is_list( Args),
	Susp =.. [suspension,_,Mref,_,_,_,_|Args],
	Exp = ( S=Susp, get_mutable( State, Mref) ).
%
%
%
user:goal_expansion( nd_init_iteration(V,_,_,Att,S), _, Exp) :-
	arg( 1, Att, Stack),
	Exp = ( get_atts(V,Att), chr:sbag_member(S,Stack) ).
%
user:goal_expansion( init_iteration(V,_,_,Att,L), _, Exp) :-
	arg( 1, Att, Stack),
	Exp = ( get_atts(V,Att), chr:iter_init(Stack,L) ).

unravel( [],	 _, true).
unravel( [X|Xs], F, (G,Gs)) :-
	G =.. [F,X],
	unravel( Xs, F, Gs).

% ----------------------- runtime user predicates -----------------

remove_constraint( Susp) :-
	nonvar( Susp),
	functor( Susp, suspension, N),
	N >= 6,
	!,
	debug_event( remove(Susp)),
	remove_constraint_internal( Susp, Vars),
	arg( 3, Susp, Module:_),
	arg( 6, Susp, F),
	A is N-6,
	Module:detach( F/A, Susp, Vars). 
remove_constraint( S) :-
	raise_exception( type_error(remove_constraint(S),1,'a constraint object',S)).

find_constraint( Term, Susp) :-
	global_term_ref_1( Global),
	find_constraint( Global, Term, Susp).

find_constraint( V, Term, Susp) :- var( V), !,
	find_constraint_internal( V, Term, Susp, active, _).
find_constraint( A, B, C) :-
	raise_exception( instantiation_error( find_constraint(A,B,C), 1)).

find_constraint_internal( V, Term, Susp, State, Module) :-
	constraint( Handler, F/A, Att),
	functor( Term, F, A),			% prune some
	arg( 1, Att, Stack),
	current_handler( Handler, Module),
	Module:get_atts( V, Att),
	length( Args, A),
	Try =.. [F|Args],
	sbag_member( Susp, Stack),
	Susp =.. [suspension,_,Mref,_,_,_,_|Args],
	get_mutable( State, Mref),
	subsumes( Term, Try).

%
% Test for unconstrained var
% Used by some math solvers
%
unconstrained( X) :-
	% var(X), prolog:'$get_cva'(X,[],_).
	find_constraint( X, _, _), !, fail.
unconstrained( _).

findall_constraints( C, L) :-
	global_term_ref_1( Global),
	findall_constraints( Global, C, L).

findall_constraints( V, C, L) :- var( V), !,
	findall( M:Att, (
			    constraint( H, F/A, Att),
			    functor( C, F, A),
			    current_handler( H, M)
			),
			Agenda),
	findall_constraints( Agenda, C, V, L, []).
findall_constraints( V, C, L) :-
	raise_exception( instantiation_error( findall_constraints(V,C,L), 1)).

findall_constraints( [],		  _, _) --> [].
findall_constraints( [Module:Att|Agenda], C, V) -->
	( {
	    arg( 1, Att, Stack),
	    Module:get_atts( V, Att),
	    iter_init( Stack, State)
	  } ->
	    findall_constraints_( State, C, Module)
	;
	    []
	),
	findall_constraints( Agenda, C, V).

findall_constraints_( State, _,       _) --> {iter_last(State)}.
findall_constraints_( State, General, Module) -->
	{
	    iter_next( State, S, Next)
	},
	( {
	    S =.. [suspension,_,Mref,_,_,_,F|Args],
	    get_mutable( active, Mref),
	    Term =.. [F|Args],
	    subsumes_chk( General, Term)
	  } ->
		[ Term#S ]
	;
		[]
	),
	findall_constraints_( Next, General, Module).

%
% Decorate a constraint Term from Module
% with a module prefix if needed.
%
module_wrap( Term, Module, Wrapped) :-
	prolog_flag( typein_module, Typein),
	( Module == Typein ->
	    Wrapped = Term
	; predicate_property( Typein:Term, imported_from(_)) ->
	    Wrapped = Term
	;
	    Wrapped = Module:Term
	).

% -----------------------------------------------------------------
/*

   Two namespaces handler/module actually only justified if there
   can be more than one handler per module ...

*/

:- dynamic handler/2.
:- dynamic constraint/3.

current_handler( Handler, Module) :-
	handler( Handler, Module).

current_constraint( Handler, C) :-
	constraint( Handler, C, _).

register_handler( Handler, Cs, Slots) :-
	prolog_load_context( module, Module),
	( handler(Other,Module),
	  Other \== Handler ->
	    raise_exception( chr(multiple_handlers(Other,Handler,Module)))
	; handler( Handler, Module) ->
	    true				% simple reload
	;
	    assert( handler(Handler,Module))
	),
	retractall( constraint(Handler,_,_)),
	reg_handler( Cs, Slots, Handler).

reg_handler( [],     [],     _).
reg_handler( [C|Cs], [S|Ss], Handler) :-
	assert( constraint(Handler,C,S)),
	reg_handler( Cs, Ss, Handler).

% ----------------------------------------------------------------

notify_constrained( X) :- var( X),
	findall( M, handler(_,M), Modules),
	notify_constrained( Modules, X).
notify_constrained( X) :- nonvar( X),
	raise_exception( instantitation_error( notify_constrained(X),1)).

notify_constrained( [], _).
notify_constrained( [M|Ms], X) :-
	M:get_suspensions( X, S),
	run_suspensions( S),
	notify_constrained( Ms, X).

%
% support for verify_attributes/3, notify_constrained/1
%
% Approximation because debug state might change between calls ...
%

run_suspensions( Slots) :-
	getval( debug, State),
	( State == off ->
	    run_suspensions_loop( Slots)
	;
	    run_suspensions_loop_d( Slots)
	),
	true.

run_suspensions_loop( []).
run_suspensions_loop( [A|As]) :-
	arg( 1, A, Stack),
	iter_init( Stack, State),
	run_suspensions_( State),
	run_suspensions_loop( As).

run_suspensions_loop_d( []).
run_suspensions_loop_d( [A|As]) :-
	arg( 1, A, Stack),
	iter_init( Stack, State),
	run_suspensions_d( State),
	run_suspensions_loop_d( As).

%
% Transition active->triggered->removed instead of
% active->removed is to avoid early gc of suspensions.
% The suspension's generation is incremented to signal
% to the revive scheme that the constraint has been
% processed already.
%
run_suspensions_( State) :- iter_last( State).
run_suspensions_( State) :-
	iter_next( State, S, Next),
	arg( 2, S, Mref),
	get_mutable( Status, Mref),
	( Status==active ->
	    update_mutable( triggered, Mref),
	    arg( 4, S, Gref),
	    get_mutable( Gen, Gref),
	    Generation is Gen+1,
	    update_mutable( Generation, Gref),
	    arg( 3, S, Goal),
	    call( Goal),
	    get_mutable( Post, Mref),
	    ( Post==triggered ->
		update_mutable( removed, Mref)
	    ;
		true
	    )
	;
	    true
	),
	run_suspensions_( Next).

run_suspensions_d( State) :- iter_last( State).
run_suspensions_d( State) :-
	iter_next( State, S, Next),
	arg( 2, S, Mref),
	get_mutable( Status, Mref),
	( Status==active ->
	    update_mutable( triggered, Mref),
	    arg( 4, S, Gref),
	    get_mutable( Gen, Gref),
	    Generation is Gen+1,
	    update_mutable( Generation, Gref),
	    arg( 3, S, Goal),
	    byrd( S, Goal),
	    get_mutable( Post, Mref),
	    ( Post==triggered ->
		update_mutable( removed, Mref)
	    ;
		true
	    )
	;
	    true
	),
	run_suspensions_d( Next).

byrd( Self, Goal) :-
	(   debug_event( wake(Self)), call( Goal)
	;   debug_event( fail(Self)), !, fail
	),
	(   debug_event( exit(Self))
	;   debug_event( redo(Self)), fail
	).

%
% Merge 2 sorted lists of Name/1 terms.
% The argument of each term is a sbag.
%
merge_attributes( [],	  Bs, Bs).
merge_attributes( [A|As], Bs, Cs) :-
	merge_attributes( Bs, Cs, A, As).

merge_attributes( [],	  [A|As], A, As).
merge_attributes( [B|Bs], Cs,	  A, As) :-
	functor( A, NameA, 1),
	functor( B, NameB, 1),
	compare( R, NameA, NameB),
	( R == < -> Cs = [A|Css], merge_attributes( As, Css, B, Bs)
	; R == > -> Cs = [B|Css], merge_attributes( Bs, Css, A, As)
	;
	    Cs = [C|Css],
	    functor( C, NameA, 1),
	    arg( 1, A, StackA),
	    arg( 1, B, StackB),
	    arg( 1, C, StackC),
	    sbag_union( StackA, StackB, StackC),
	    merge_attributes( As, Bs, Css)
	).

show_bag( Bag) :-
	iter_init( Bag, State),
	show_bag_( State),
	nl.

show_bag_( State) :- iter_last( State).
show_bag_( State) :-
	iter_next( State, S, Next),
	arg( 2, S, Ref),
	get_mutable( St, Ref),
	format( ' ~p:~p', [S,St]),
	show_bag_( Next).

%
% Support for attribute_goal/2.
%
% Complication: the Sicstus kernel removes duplicates
% via call_residue/2 - that includes the toplevel.
% We may want to see them ->
%   tag Term with Suspension, 'untag' via portray/1
%
% Called with a list of slots once per module
%
attribute_goals( L, Goal, Module) :-
	attribute_goal_loop( L, Module, GL, []),
	l2c( GL, Goal).

attribute_goal_loop( [],     _) --> [].
attribute_goal_loop( [A|As], Mod) -->
	{
	    arg( 1, A, Stack),
	    iter_init( Stack, State)
	},
	attgs_( State, Mod),
	attribute_goal_loop( As, Mod).

attgs_( State, _) --> {iter_last( State)}.
attgs_( State, Module) -->
	{
	    iter_next( State, S, Next),
	    S =.. [suspension,_,Mref,_,_,_,F|Args]
	},
	( {get_mutable(active,Mref)} ->
	     {
	       Term =.. [F|Args],
	       module_wrap( Term, Module, Wrapped)
	     },
	     [ '$want_duplicates'(S,Wrapped) ]
	;
	     []
	),
	attgs_( Next, Module).

%
% fail for empty list
%
l2c( [C], C) :- !.
l2c( [C|Cs], (C,Cj)) :-
	l2c( Cs, Cj).

%
% Unlink removed constraints cleanly from all chains
% Still need gc state because of wake,
% but re-insertion = insert because of complete removal.
%
chr_gc :-
	global_term_ref_1( Global),
	findall( M, handler(_,M), Modules),
	chr_gcm( Modules, Global).

chr_gcm( [],	 _).
chr_gcm( [M|Ms], Global) :-
	M:get_suspensions( Global, AllS),
	term_variables( [Global|AllS], Vars),	% AllS may be ground
	chr_gcv( Vars, M),
	chr_gcm( Ms, Global).

%
% Have compiler generated support?
%
chr_gcv( [],	 _).
chr_gcv( [V|Vs], M) :-
	M:get_suspensions( V, Old),
	chr_gcb( Old, New),
	M:put_suspensions( V, New),
	chr_gcv( Vs, M).

chr_gcb( [],	 []).
chr_gcb( [S|Ss], [Sgc|Ts]) :-
	arg( 1, S, Bag),
	iter_init( Bag, State),
	functor( S, N, 1),
	functor( T, N, 1),
	gc_bag( State, Lgc),
	( Lgc==[] ->
	    Sgc = -T
	;
	    Sgc = T,
	    list_to_sbag( Lgc, BagGc),
	    arg( 1, T, BagGc)
	),
	chr_gcb( Ss, Ts).

gc_bag( State, []) :- iter_last( State).
gc_bag( State, L) :-
	iter_next( State, Susp, Next),
	arg( 2, Susp, Mref),
	get_mutable( SuspState, Mref),
	( SuspState==removed ->
	    L = Tail,
	    update_mutable( gc, Mref)
	; SuspState==gc ->
	    L = Tail
	;
	    L = [Susp|Tail]
	),
	gc_bag( Next, Tail).

% --------------------------------------------------------------------
%
% Incremental allocation & activation of constraints.
% Attachment code of closures to variables is generated
% by the compiler.
%
% States {passive(Term),inactive,triggered,active,removed,gc}
%
%

:- meta_predicate allocate_constraint(:,-,+,+).
%
allocate_constraint( Closure, Self, F, Args) :-
	empty_history( History),
	create_mutable( passive(Args), Mref),
	create_mutable( 0, Gref),
	create_mutable( History, Href),
	gen_id( Id),
	Self =.. [suspension,Id,Mref,Closure,Gref,Href,F|Args].

%
% activate_constraint( -, +, -).
%
% The transition gc->active should be rare
%
activate_constraint( Vars, Susp, Generation) :-
	arg( 2, Susp, Mref),
	get_mutable( State, Mref),
	update_mutable( active, Mref),
	( nonvar(Generation) ->			% aih
	    true
	;
	    arg( 4, Susp, Gref),
	    get_mutable( Gen, Gref),
	    Generation is Gen+1,
	    update_mutable( Generation, Gref)
	),
	( compound(State) ->			% passive/1
	    term_variables( State, Vs),
	    none_locked( Vs),
	    global_term_ref_1( Global),
	    Vars = [Global|Vs]
	; State==gc ->				% removed from all chains
	    Susp =.. [_,_,_,_,_,_,_|Args],
	    term_variables( Args, Vs),
	    global_term_ref_1( Global),
	    Vars = [Global|Vs]
	; State==removed ->			% the price for eager removal ...
	    Susp =.. [_,_,_,_,_,_,_|Args],
	    term_variables( Args, Vs),
	    global_term_ref_1( Global),
	    Vars = [Global|Vs]
	;
	    Vars = []
	).

%
% Combination of the prev. two
%
:- meta_predicate insert_constraint_internal(-,-,:,+,+).
%
insert_constraint_internal( [Global|Vars], Self, Closure, F, Args) :-
	term_variables( Args, Vars),
	none_locked( Vars),
	global_term_ref_1( Global),
	empty_history( History),
	create_mutable( active, Mref),
	create_mutable( 0, Gref),
	create_mutable( History, Href),
	gen_id( Id),
	Self =.. [suspension,Id,Mref,Closure,Gref,Href,F|Args].

:- meta_predicate insert_constraint_internal(-,-,?,:,+,+).
%
insert_constraint_internal( [Global|Vars], Self, Term, Closure, F, Args) :-
	term_variables( Term, Vars),
	none_locked( Vars),
	global_term_ref_1( Global),
	empty_history( History),
	create_mutable( active, Mref),
	create_mutable( 0, Gref),
	create_mutable( History, Href),
	gen_id( Id),
	Self =.. [suspension,Id,Mref,Closure,Gref,Href,F|Args].

gen_id( Id) :-
	incval( id, Id).
        /* no undo/1 in sicstus3.7
	( Id =:= 1 ->				% first time called
	    undo( setval(id,0))
	;
	    true
	).
	*/

%
% Eager removal from all chains.
%
remove_constraint_internal( Susp, Agenda) :-
	arg( 2, Susp, Mref),
	get_mutable( State, Mref),
	update_mutable( removed, Mref),		% mark in any case
	( compound(State) ->			% passive/1
	    Agenda = []
	; State==removed ->
	    Agenda = []
	; State==triggered ->
	    Agenda = []
	;
            Susp =.. [_,_,_,_,_,_,_|Args],
	    term_variables( Args, Vars),
	    global_term_ref_1( Global),
	    Agenda = [Global|Vars]
	).

%
% Protect the goal against any binding
% or attachment of constraints. The latter is
% via the notify_constrained/1 convention.
%
lock( T) :- var(T), put_atts( T, locked).
lock( T) :- nonvar( T),
	functor( T, _, N),
	lock_arg( N, T).

lock_arg( 0, _) :- !.
lock_arg( 1, T) :- !, arg( 1, T, A), lock( A).
lock_arg( 2, T) :- !, arg( 1, T, A), lock( A), arg( 2, T, B), lock( B).
lock_arg( N, T) :-
	arg( N, T, A),
	lock( A),
	M is N-1,
	lock_arg( M, T).

unlock( T) :- var(T), put_atts( T, -locked).
unlock( T) :- nonvar( T),
	functor( T, _, N),
	unlock_arg( N, T).

unlock_arg( 0, _) :- !.
unlock_arg( 1, T) :- !, arg( 1, T, A), unlock( A).
unlock_arg( 2, T) :- !, arg( 1, T, A), unlock( A), arg( 2, T, B), unlock( B).
unlock_arg( N, T) :-
	arg( N, T, A),
	unlock( A),
	M is N-1,
	unlock_arg( M, T).

verify_attributes( X, Y, []) :-
	get_atts( X, locked),
	!,
	var(Y),
	get_atts( Y, -locked),
	put_atts( Y,  locked).
verify_attributes( _, _, []).

none_locked( []).
none_locked( [V|Vs]) :-
	not_locked( V),
	none_locked( Vs).

not_locked( V) :- var( V), get_atts( V, -locked).
not_locked( V) :- nonvar( V).

% -------------------------- access to constraints ------------------

%
% Try a list of candidates. V may be nonvar but
% bound to a term with variables in it.
%
via( L, V) :-
	member( X, L),
	var( X),
	!,
	V = X.
via( L, V) :-
	compound( L),
	nonground( L, V),
	!.
via( _, V) :-
	global_term_ref_1( V).

%
% specialization(s)
%
via_1( X, V) :- var(X), !, X=V.
via_1( T, V) :- compound(T), nonground( T, V), !.
via_1( _, V) :- global_term_ref_1( V).

via_2( X, _, V) :- var(X), !, X=V.
via_2( _, Y, V) :- var(Y), !, Y=V.
via_2( T, _, V) :- compound(T), nonground( T, V), !.
via_2( _, T, V) :- compound(T), nonground( T, V), !.
via_2( _, _, V) :- global_term_ref_1( V).

via_3( X, _, _, V) :- var(X), !, X=V.
via_3( _, Y, _, V) :- var(Y), !, Y=V.
via_3( _, _, Z, V) :- var(Z), !, Z=V.
via_3( T, _, _, V) :- compound(T), nonground( T, V), !.
via_3( _, T, _, V) :- compound(T), nonground( T, V), !.
via_3( _, _, T, V) :- compound(T), nonground( T, V), !.
via_3( _, _, _, V) :- global_term_ref_1( V).


%
% The second arg is a witness.
% The formulation with term_variables/2 is
% cycle safe, but it finds a list of all vars.
% We need only one, and no list in particular.
%
nonground( Term, V) :-
	term_variables( Term, Vs),
	Vs = [V|_].

/*
nonground( Term, V) :- var( Term), V=Term.
nonground( Term, V) :- compound( Term),
	functor( Term, _, N),
	nonground( N, Term, V).

%
% assert: N > 0
%
nonground( 1, Term, V) :- !,
	arg( 1, Term, Arg),
	nonground( Arg, V).
nonground( 2, Term, V) :- !,
	arg( 2, Term, Arg2),
	( nonground( Arg2, V) ->
	    true
	;
	    arg( 1, Term, Arg1),
	    nonground( Arg1, V)
	).
nonground( N, Term, V) :-
	arg( N, Term, Arg),
	( nonground( Arg, V) ->
	    true
	;
	    M is N-1,
	    nonground( M, Term, V)
	).
*/

constraint_generation( Susp, State, Generation) :-
	arg( 2, Susp, Mref),
	get_mutable( State, Mref),
	arg( 4, Susp, Gref),
	get_mutable( Generation, Gref). 	% not incremented meanwhile

change_state( Susp, State) :-
	arg( 2, Susp, Mref),
	update_mutable( State, Mref).

:- meta_predicate expose(-,+,+,+,:).
%
expose_active( Ref, Head, Tid, Heads, Continuation) :-
	get_exposed( Ref),
	get_mutable( Exposed, Ref),
	update_mutable( [active(Head,Tid,Heads,Continuation)|Exposed], Ref).

expose_passive( Ref, Heads) :-
	get_exposed( Ref),
	get_mutable( Exposed, Ref),
	update_mutable( [passive(Heads)|Exposed], Ref).

de_expose( Ref) :-
	get_mutable( [_|Exposed], Ref),
	update_mutable( Exposed, Ref).

%
% Prefer passive over active (cheaper to deal with).
%
is_exposed( Constraint, Suspension, Continuation) :-
	get_exposed( Ref),
	get_mutable( Exposed, Ref),
	is_exposed( Exposed, Constraint, Suspension, Continuation).

is_exposed( [E|Es], Constraint, Suspension, Continuation) :-
	is_exposed( E, Constraint, Suspension, Continuation, Es).

is_exposed( active(Head,Susp,Heads,Cont), Constraint, Suspension, Continuation, Es) :-
	( member( C#Suspension, Heads),
	  Constraint == C ->
	    Continuation = true
	; Constraint == Head ->
	    ( is_exposed( Es, Constraint, Suspension, true) -> % prefer
		Continuation = true
	    ;
		Continuation = Cont,
		Suspension = Susp
	    )
	;
	    is_exposed( Es, Constraint, Suspension, Continuation)
	).
is_exposed( passive(Heads), Constraint, Suspension, Continuation, Es) :-
	( member( C#Suspension, Heads),
	  Constraint == C ->
	    Continuation = true
	;
	    is_exposed( Es, Constraint, Suspension, Continuation)
	).

get_exposed( Ref) :-
	global_term_ref_1( Global),
	( get_atts( Global, exposed(Ref)) ->
	    true
	;
	    create_mutable( [], Ref),
	    put_atts( Global, exposed(Ref))
	).

get_dbg_state( Ref) :-
	global_term_ref_1( Global),
	( get_atts( Global, dbg_state(Ref)) ->
	    true
	;
	    create_mutable( [], Ref),
	    put_atts( Global, dbg_state(Ref))
	).

% ------------------- abstract data type for propagation rules -------------

empty_history( E) :- empty_assoc( E).

%
% assert: constraints/tuples are comparable directly
%
novel_production( Self, Tuple) :-
	arg( 5, Self, Ref),
	get_mutable( History, Ref),
	( get_assoc( Tuple, History, _) ->
	    fail
	;
	    true
	).

%
% Not folded with novel_production/2 because guard checking
% goes in between the two calls.
%
extend_history( Self, Tuple) :-
	arg( 5, Self, Ref),
	get_mutable( History, Ref),
	put_assoc( Tuple, History, x, NewHistory),
	update_mutable( NewHistory, Ref).

% vsc
%
global_term_ref(I,X) :- array_element(global_term_ref, I, X).
global_term_ref_0(X) :- array_element(global_term_ref, 0, X).
global_term_ref_1(X) :- array_element(global_term_ref, 1, X).

:- yap_flag(toplevel_hook,chr:create_global_array).

create_global_array :- ( array(global_term_ref,2) -> true ; true).


%
% vsc
%
%:- load_foreign_resource(library(system(chr))).

end_of_file.