This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/CHR/chr.yap
2002-01-02 23:39:10 +00:00

909 lines
21 KiB
Prolog

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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.