/*
 * BEGIN LICENSE BLOCK
 * Version: CMPL 1.1
 *
 * The contents of this file are subject to the Cisco-style Mozilla Public
 * License Version 1.1 (the "License"); you may not use this file except
 * in compliance with the License.  You may obtain a copy of the License
 * at www.eclipse-clp.org/license.
 * 
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
 * the License for the specific language governing rights and limitations
 * under the License. 
 * 
 * The Original Code is  The ECLiPSe Constraint Logic Programming System. 
 * The Initial Developer of the Original Code is  Cisco Systems, Inc. 
 * Portions created by the Initial Developer are
 * Copyright (C) 1990,2006 Cisco Systems, Inc.  All Rights Reserved.
 * 
 * Contributor(s): Mireille Ducasse, ECRC.
 * 
 * END LICENSE BLOCK
 *
 *	$Id: extension.op,v 1.1.1.1 2006/09/23 01:54:31 snovello Exp $
 *
 */

/*
 *  procedures which retrieve the values of the trace line slots,
 *  and which position the trace pointer in the database;
 *  they are basic primitives for the extension of Opium
 *  (part of scenario kernel)
 */


:- op(500, fx, =).
:- op(500, fx, <).
:- op(500, fx, =<).
:- op(500, fx, >).
:- op(500, fx, >=).


/*	
 *	CURR-CHRONO
 */
opium_primitive(
	name		: curr_chrono,
	arg_list	: [Chrono],
	arg_type_list	: [is_integer_or_var],
	abbrev		: c_chrono,
	implementation	: curr_chrono_Op,
	message		:
"Primitive which gets or checks the value of the \"chrono\" slot of the current \n\
trace line." ).

curr_chrono_Op(C) :- 
	curr_chrono_ok(C).

curr_chrono_ok(C) :-
	exchange_with_prolog_synchronously(curr_chrono_pk(X), curr_chrono_pk(C)).


/*	
 *	CURR-CALL
 */
opium_primitive(
	name		: curr_call,
	arg_list	: [Call],
	arg_type_list	: [is_integer_or_var],
	abbrev		: c_call,
	implementation	: curr_call_Op,
	message		:
"Primitive which gets or checks the value of the \"call\" slot of the current \n\
trace line."
	).

curr_call_Op(C):- 
	curr_call_ok(C).

curr_call_ok(C) :-
	exchange_with_prolog_synchronously(curr_call_pk(X), curr_call_pk(C)).


/*	
 *	CURR-DEPTH
 */
opium_primitive(
	name		: curr_depth,
	arg_list	: [Depth],
	arg_type_list	: [is_integer_or_var],
	abbrev		: c_depth,
	implementation	: curr_depth_Op,
	message		:
"Primitive which gets or checks the value of the \"depth\" slot of the current \n\
trace line."
	).

curr_depth_Op(C):- 
	curr_depth_ok(C).

curr_depth_ok(D) :-
	exchange_with_prolog_synchronously(curr_depth_pk(X), curr_depth_pk(D)).


/*
 *	CURR-PORT
 */
opium_primitive(
	name		: curr_port,
	arg_list	: [Port],
	arg_type_list	: [is_atom_or_var],
	abbrev		: c_port,
	implementation	: curr_port_Op,
	message		:
"Primitive which gets or checks the value of the \"port\" slot of the current \n\
trace line."
	).

curr_port_Op(P):- 
	curr_port_ok(PN),
	decode_port(P, PN).

curr_port_ok(P) :-
	exchange_with_prolog_synchronously(curr_port_pk(X), curr_port_pk(P)).


/*
 *	CURR-PRED
 */
opium_primitive(
	name		: curr_pred,
	arg_list	: [Pred],
	arg_type_list	: [is_pred_or_var],
	abbrev		: c_pred,
	implementation	: curr_pred_Op,
	message		:
 "Primitive which gets or checks the value of the predicate used in \n\
the current trace line. If Pred is partially instantiated it must be \n\
of the form Mod:Pred/Arity."
	).

curr_pred_Op(M:P/A) :- 
	curr_pred_ok(M:P/A).

curr_pred_ok(M:P/A) :-
	exchange_with_prolog_synchronously(curr_pred_pk(M0:X/Y), curr_pred_pk(M:P/A)).


/*
 *	CURR-ARG
 */
opium_primitive(
	name		: curr_arg,
	arg_list	: [ArgList],
	arg_type_list	: [is_list_or_var],
	abbrev		: c_arg,
	implementation	: curr_arg_Op,
	message		:
"Primitive which gets or checks the value of the \"argument\" slot of the \n\
current trace line."
	).

curr_arg_Op(A) :- 
	curr_arg_ok(A).

curr_arg_ok(Arg) :-
	exchange_with_prolog_synchronously(curr_arg_pk(X), curr_arg_pk(A)),
	term_string(Arg, A).


/*
 *	CURR-LINE
 */
opium_primitive(
	name		: curr_line,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_or_var, is_integer_or_var, 
				is_integer_or_var,
				is_atom_or_var, is_pred_or_var],
	abbrev		: c_line,
	implementation	: curr_line_Op,
	message		:
"Primitive which gets or checks the values of all the slots except the \n\
arguments of the current trace line."
	).

curr_line_Op(Chrono, Call, Depth, Port, Mod:P/A) :-
	!,
	curr_line_ok(Chrono, Call, Depth, PortInt, Mod:P/A),
	decode_port(Port, PortInt).

curr_line_ok(Chrono, Call, Depth, PortInt, Mod:Pred/Arity) :-
	exchange_with_prolog_synchronously(curr_line_pk(Ch, C, D, PI, M:P/A), 
		curr_line_pk(Chrono, Call, Depth, PortInt, Mod:Pred/Arity)).



/*
 *	F-GET
 */
opium_command(
	name		: f_get,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot,
				is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: fg,
	interface	: button,
	command_type	: trace,
	implementation	: f_get_Op,
	parameters	: [],
	message		:
 "Command which searches forwards the *first* line corresponding to \n\
the specified slot values, and prints it. For Chrono, Call, and Depth \n\
you can specify an exact value, a list of values, or a semi-interval, \n\
for example \"< 4\".  Port and Pred may be lists of values, or negated \n\
lists, for example \"~[next, fail]\"."
	).

f_get_Op(Chrono, Call, Depth, Port, Pred) :- 
	f_get_bare(Chrono, Call, Depth, Port, Pred),
	bind_slots(Chrono, Call, Depth, Port, Pred).

/*
 *	F-GET-BARE
 */
opium_primitive(
	name		: f_get_bare,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot, 
			is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: _,
	implementation	: f_get_bare_Op,
	message		:
 "Primitive which behaves like f_get_np/5, but it does not unify the \n\
unspecified slots, therefore it is cheaper. \n\
 \n\
*** Note that this is one of the few very basic primitives of Opium. \n\
This is, most likely, the one to customize (together with b_get_bare/5,  \n\
and print_line/0) if you want a slightly different execution model and  \n\
no parameter can be set appropriately."
	).

/*
 *  f_get_bare/5 does not bind the slots, so it is cheaper
 */
f_get_bare_Op(Chrono, Call, Depth, Port, Pred) :-	
	change_slot(Chrono, ChronoVal, ChronoOp),
	change_slot(Call,   CallVal,   CallOp),
	change_slot(Depth,  DepthVal,  DepthOp),
	change_slot(Port,   PortVal,   PortOp),			
	change_pred_slot(Pred,   PredVal,  PredOp),
	decode_port_or_portlist(PortVal, PortBis),
	!,
	f_get_ok(ChronoVal, ChronoOp, CallVal, CallOp, DepthVal, DepthOp,
			PortBis, PortOp, PredVal, PredOp).

f_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9) :-
	not traced_execution_running,
	opium_write(error, "no execution running\n"),
	!,
	fail.
f_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9) :-
	exchange_with_prolog_synchronously
		(f_get_pk(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9), fail),
	!,
	fail.
f_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9).
f_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9) :-
	f_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9).


/*
 *	DET-F-GET
 */
opium_command(
	name		: det_f_get,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot,
				is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: dfg,
	interface	: menu,
	command_type	: trace,
	implementation	: det_f_get_Op,
	parameters	: [],
	message		:
"Command which searches forwards in the trace like \"f_get\", but it is not \n\
backtrackable."
	).

det_f_get_Op(Chrono, Call, Depth, Port, Pred) :-
	f_get_np(Chrono, Call, Depth, Port, Pred),
	!.


/*
 *	DET-F-GET-BARE
 */
opium_primitive(
	name		: det_f_get_bare,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot, 
			is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: _,
	implementation	: det_f_get_bare_Op,
	message		:
'Primitive which behaves like det_f_get_np/5 but it does not unify the \n\
unspecified slots, therefore it is cheaper.'
	).

det_f_get_bare_Op(Chrono, Call, Depth, Port, Pred) :-
	f_get_bare(Chrono, Call, Depth, Port, Pred),
	!.



/* 	
 *	B-GET	
 */
opium_command(
	name		: b_get,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot,
			   is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: bg,
	interface	: button,
	command_type	: trace,
	implementation	: b_get_Op,
	parameters	: [],
	message		:
 "Command which searches backwards the *first* line corresponding to \n\
the specified slot values, and prints it. For Chrono, Call and Depth \n\
you can specify an exact value, a list of values, or a semi-interval, \n\
for example \"< 4\".  Port and Pred may be lists of values, or negated \n\
lists, for example \"~[next, fail]\"."
	).

b_get_Op(Chrono, Call, Depth, Port, Pred) :- 
	trace_recorded,
	!,
	b_get_bare(Chrono, Call, Depth, Port, Pred),
	bind_slots(Chrono, Call, Depth, Port, Pred).
b_get_Op(_,_,_,_,_) :-
	opium_write(error, "no trace lines recorded\n"),
	fail.

/*
 *	B-GET-BARE
 */
opium_primitive(
	name		: b_get_bare,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot, 
			is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: _,
	implementation	: b_get_bare_Op,
	message		:
'Primitive which behaves like b_get_np/5, but it does not unify the \n\
unspecified slots, therefore it is cheaper. \n\
 \n\
*** Note that this is one of the few very basic primitives of Opium. \n\
This is, most likely, the one to customize (together with f_get_bare/5,  \n\
and print_line/0) if you want a slightly different execution model and  \n\
no parameter can be set appropriately.'
	).

b_get_bare_Op(Chrono, Call, Depth, Port, Pred) :-
	change_slot(Chrono, ChronoVal, ChronoOp),
	change_slot(Call,   CallVal,  CallOp),
	change_slot(Depth,  DepthVal, DepthOp),
	change_slot(Port,   PortVal,  PortOp),			
	change_pred_slot(Pred,   PredVal,  PredOp),	
	decode_port_or_portlist(PortVal, PortBis),
	b_get_ok(ChronoVal, ChronoOp, CallVal, CallOp, DepthVal, DepthOp,
			PortBis,PortOp, PredVal, PredOp).

b_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9) :-
	not traced_execution_running,
	opium_write(error, "no execution running\n"),
	!,
	fail.
b_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9) :-
	exchange_with_prolog_synchronously
		(b_get_pk(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9), fail),
	!,
	fail.
b_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9).
b_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9) :-
	b_get_ok(P0, P1, P2, P3, P4, P5, P6, P7, P8, P9).


/*
 *	DET-B-GET-BARE
 */
opium_primitive(
	name		: det_b_get_bare,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot, 
			is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: _,
	implementation	: det_b_get_bare_Op,
	message		:
"Primitive which behaves like det_b_get_np/5 but it does not unify the \n\
unspecified slots, therefore it is cheaper."
	).

det_b_get_bare_Op(Chrono, Call, Depth, Port, Pred) :-
	b_get_bare(Chrono, Call, Depth, Port, Pred),
	!.
	

/*
 *	DET-B-GET
 */
opium_command(
	name		: det_b_get,
	arg_list	: [Chrono, Call, Depth, Port, Pred],
	arg_type_list	: [is_integer_slot, is_integer_slot,
				is_integer_slot, is_port_slot, is_pred_slot],
	abbrev		: dbg,
	interface	: menu,
	command_type	: trace,
	implementation	: det_b_get_Op,
	parameters	: [],
	message		:
"Command which searches backwards in the trace like \"b_get\", but it is not \n\
backtrackable."
	).

det_b_get_Op(Chrono, Call, Depth, Port, Pred) :-
	b_get_np(Chrono, Call, Depth, Port, Pred),
	!.


/*
 *	GOTO
 */
opium_command(
	name		: goto,
	arg_list	: [C],
	arg_type_list	: [integer],
	abbrev		: g,
	interface	: menu,
	command_type	: trace,
	implementation	: goto_Op,
	parameters	: [],
	message		:
"Command which moves the trace pointer to the line with chronological number C.\n\
Note that a customization of *_get_bare/5 will NOT affect the behaviour of goto/1."
	).

goto_Op(C) :-
	curr_chrono(C1),
	goto(C, C1),
	!.

goto(Dest, Dest) :-
	!.
goto(Dest, Curr) :-
	Dest < Curr,
	!,
	goto_back(Dest).
goto(Dest, Curr) :-
	f_get_ok(Dest, 1, 0, 0, 0, 0, 0, 0, 0, 0).

goto_back(Dest) :-
	trace_recorded,
	!,
	b_get_ok(Dest, 1, 0, 0, 0, 0, 0, 0, 0, 0).
goto_back(Dest) :-
	opium_write(error, "no trace lines recorded\n"),
	fail.



/*	
 *	F_LEAP	
 */
opium_command(
	name		: f_leap,
	arg_list	: [],
	arg_type_list	: [],
	abbrev		: _,
	interface	: button,
	command_type	: trace,
	implementation	: f_leap_Op,
	parameters	: [],
	message		:
 "Command which searches forward the first trace line related to a  \n\
spypoint and prints it.  To set a spy point use \"spy/1\"." ).

f_leap_Op :- 
	spy_points_exist,
	f_leap_ok.

f_leap_ok :-
	not traced_execution_running,
	opium_write(error, "no execution running\n"),
	!,
	fail.
f_leap_ok :-
	remote_once(leap_pk, sepia_kernel),	
	(	true
	;
		f_leap_ok
	).



/*
 *	B_LEAP
 */
opium_command(
	name		: b_leap,
	arg_list	: [],
	arg_type_list	: [],
	abbrev		: _,
	interface	: button,
	command_type	: trace,
	implementation	: b_leap_Op,
	parameters	: [],
	message		:
 "Command which searches backward the first trace line related to a \n\
spypoint and prints it.  To set a spy point use \"spy/1\"."
	).

b_leap_Op :-
	spy_points_exist,
	b_leap_ok.

b_leap_ok :-
	not traced_execution_running,
	opium_write(error, "no execution running\n"),
	!,
	fail.
b_leap_ok :-
	remote_once(leap_back_pk, sepia_kernel),
	(	true
	;
		b_leap_ok
	).

/*
 *	SPY_POINTS_EXIST
 */
opium_primitive(
	name		: spy_points_exist,
	arg_list	: [],
	arg_type_list	: [],
	abbrev		: _,
	implementation	: spy_points_exist_Op,
	message		:
 "Primitive which checks whether there are spy points set."
	).

spy_points_exist_Op :-
	get_parameter(flagged_pred, [_, spy]),
	!.
spy_points_exist_Op :-
	opium_write(error, "no spy-points defined\n"),
	fail.



/*
 *	IS-INTEGER-SLOT
 */
opium_type(
	name		: is_integer_slot,
	implementation	: is_integer_slot_Op,
	message		: 
 "Type which succeeds for an integer, a semi-interval (e.g. >2), a \n\
list of integers, or a variable."
	).

is_integer_slot_Op(I) :-
	var(I), 
	!.
is_integer_slot_Op(I) :-
	integer(I), 
	!.
is_integer_slot_Op(= I) :-
	integer(I),
	!.
is_integer_slot_Op(< I) :-
	integer(I), 
	!.
is_integer_slot_Op(=< I) :-
	integer(I), 
	!.
is_integer_slot_Op(> I) :-
	integer(I), 
	!.
is_integer_slot_Op(>= I) :-
	integer(I), 
	!.
is_integer_slot_Op(~ I) :-
	integer(I), 
	!.
is_integer_slot_Op([X]) :-
	integer(X),
	!.
is_integer_slot_Op([X|Xs]) :-
	integer(X),
	is_integer_slot_Op(Xs),
	!.
is_integer_slot_Op(~ [X]) :-
	integer(X),
	!.
is_integer_slot_Op(~ [X|Xs]) :-
	integer(X),
	is_integer_slot_Op(Xs).


/*
 *	IS-PORT
 */
opium_type(
	name		: is_port,
	implementation	: is_port_Op,
	message		: 
 "Type which succeeds for an Opium port. Valid ports are: call, next \n\
redo, exit, exit_c, fail, delay, resume, unify, cut, leave.\n\
BEWARE: next and redo have sightly differnt meanings than in Sepia tracer ! \n\
\n\
 call:   invocation of the current goal; \n\
 next:   (real) backtracing to the current goal; \n\
 redo:   backtracing to a *subgoal* of the current goal; \n\
 exit:   successful execution of the current goal (leaving no choice points); \n\
 exit_c: successful execution of the current goal (leaving choice points  \n\
         on either the current goal or one of its subgoals); \n\
 fail:   failure of the current goal; \n\
 delay:  suspension of the execution of the current goal (coroutining); \n\
 resume: waking up of the current goal (coroutining); \n\
 unify:  unification of the current goal with one clause head; \n\
 cut:    the current goal is being cut; \n\
 leave:  due to an error the execution of the current goal is interrupted."
	).

is_port_Op(P) :-
	decode_port(P, _).


/*
 *	IS-LIST-OF-PORTS
 */
opium_type(
	name		: is_list_of_ports,
	implementation	: is_list_of_ports_Op,
	message		: 
'Type which succeeds for a sublist of [call, next, redo, exit, exit_c, \n\
fail, delay, resume, unify, cut, leave].'
	).

is_list_of_ports_Op([P]) :-
	is_port(P).
is_list_of_ports_Op([P|Ps]) :-
	is_port(P),
	is_list_of_ports_Op(Ps).



/*
 *	IS-PORT-SLOT
 */
opium_type(
	name		: is_port_slot,
	implementation	: is_port_slot_Op,
	message		: 
 "Type which succeeds for a port (eg \"call\"), a (negated) list of \n\
ports (eg [\"call\", \"fail\"] or ~[\"call\", \"fail\"]), or a \n\
variable.  Valid ports are call, next, redo, exit, exit_c, fail, \n\
delay, resume, unify, cut, leave."
	).

is_port_slot_Op(X) :-
	var(X),
	!.
is_port_slot_Op(X) :-
	is_port(X),
	!.
is_port_slot_Op(~ X) :-
	is_port(X),
	!.
is_port_slot_Op([X]) :-
	is_port(X),
	!.
is_port_slot_Op([X|Xs]) :-
	is_port(X),
	is_port_slot(Xs),
	!.
is_port_slot_Op(~ [X]) :-
	is_port(X),
	!.
is_port_slot_Op(~ [X|Xs]) :-
	is_port(X),
	is_port_slot(Xs).



/*
 *	IS-PRED-SLOT
 */
opium_type(
	name		: is_pred_slot,
	implementation	: is_pred_slot_Op,
	message		: 
 "Type which succeeds for variable, (negated) predicate (eg P, P/A or \n\
M:P/A), or (negated) list of predicates. the module can be either   \n\
missing, variable or instantiated. The predicate name and arity must \n\
have the same type (ie either both instantiated, or both variable) \n\
because  Opium matching procedure can only handle predicates with  \n\
arity. This may be fixed in a later version."
	).

is_pred_slot_Op(P) :-
	var(P),
	!.
is_pred_slot_Op(P/A) :-
	is_pred_slot_do(P/A),
	!.
is_pred_slot_Op(M:P/A) :-
	(var(M); atom(M)),
	is_pred_slot_do(P/A),
	!.
is_pred_slot_Op(M:P) :-
	(var(M); atom(M)),
	var(P),
	!.
is_pred_slot_Op(~M:P/A) :-
	(var(M); atom(M)),
	atom(P),
	integer(A),
	!.
is_pred_slot_Op(~P/A) :-
	(var(M); atom(M)),
	atom(P),
	integer(A),
	!.
is_pred_slot_Op(P) :-
	is_list_of_pred_slots(P),
	!.
is_pred_slot_Op(~ P) :-
	is_list_of_pred_slots(P).


is_pred_slot_do(P/A) :-
	( var(P), var(A)
	; atom(P), integer(A)
	).

is_list_of_pred_slots([]).
is_list_of_pred_slots([P | Tail]) :-
	is_pred_slot(P),	     % sensitive to customizations of is_pred_slot
	is_list_of_pred_slots(Tail).

/* 		
 *  change_slot(+Slot, -Value, -Operator) 
 *  change_pred_slot(+Slot, -Value, -Operator)
 *  This is used by f_get and b_get to be able to specify the
 *  value of the slots in a more clever way than simply an exact value.
 */
change_slot(Slot, 0, 0) :-
	var(Slot),
	!.
change_slot(Slot, 0, 0) :-
	Slot =.. [F | [Val]],
	var(Val),
	!.
change_slot(= X, X, 1) 	:- !.
change_slot(< X, X, 2) 	:- !.
change_slot(=< X, X, 3) :- !.
change_slot(> X, X, 4) 	:- !.
change_slot(>= X, X, 5) :- !.
change_slot(~ [X|T], [X|T], 8) :- !. 	% not member
change_slot(~ X, X, 6) :- !.
change_slot([X|T], [X|T], 7) :- !.	% member
change_slot(X, X, 1) :- !.		% default operator 


/*
 * If the module is not specified (ie P/A) it is replaced by a variable
 */
change_pred_slot(X, 0, 0) :-
	var(X),
	!.
change_pred_slot(Mod:P/A, 0, 0) :-
	var(Mod),
	var(P),
	var(A),
	!.
change_pred_slot(P/A, 0, 0) :-
	var(P),
	var(A),
	!.
change_pred_slot(= Mod:P/A, [Mod, P/A],  1) :- !.
change_pred_slot(= P/A,     [_Mod, P/A], 1) :- !.
change_pred_slot(~ Mod:P/A, [Mod, P/A],  6) :- !.
change_pred_slot(~ P/A,     [_Mod, P/A], 6) :- !.
change_pred_slot(Mod:P/A,   [Mod, P/A],  1) :- !. 	% default op
change_pred_slot(P/A,       [_Mod, P/A], 1) :- !. 	% default op
change_pred_slot([Mod:P/A | T], [Mod, P/A | T1],  7) :-      % member
	!,
	change_pred_slot_l(T, T1).
change_pred_slot([P/A | T],     [_Mod, P/A | T1], 7) :-	     % member
	!,
	change_pred_slot_l(T, T1).
change_pred_slot(~ [Mod:P/A | T], [Mod, P/A | T1],  8) :-    % not member
	!,
	change_pred_slot_l(T, T1).
change_pred_slot(~ [P/A | T],     [_Mod, P/A | T1], 8) :-    % not member
	!,
	change_pred_slot_l(T, T1).
change_pred_slot(X, _, _) :-
	opium_printf(error, "%w is not a good specification of the pred slot\n", [X]),
	fail.

change_pred_slot_l([], []).
change_pred_slot_l([Mod:P/A | T], [Mod, P/A | T1]) :-
	!,
	change_pred_slot_l(T, T1).
change_pred_slot_l([P/A | T],     [_Mod, P/A | T1]) :-
	!,
	change_pred_slot_l(T, T1).

/*
 *  bind_slots(?Chrono, ?Call, ?Depth, ?Port, ?Pred)
 *  used by f_get/5 and b_get/5; the slots which are free variables 
 *  in the call are instantiated with their actual values
 */
bind_slots(Chrono, Call, Depth, Port, Pred) :-
	curr_line(CurrChrono, CurrCall, CurrDepth, CurrPort, CurrPred),
	unify_slots([Chrono,Call,Depth,Port,Pred],
		[CurrChrono, CurrCall, CurrDepth, CurrPort, CurrPred]),
	!.

/* 
 *  unify_slots(+SlotsInGoal, +ActualSlots)
 *  The slots cannot simply be unified because even if f_get or b_get
 *  succeeds a slot does not unify if it is specified eg. by a list
 */
unify_slots(L, L) :-
	!.
unify_slots([P1, P2, P3, P4, M:P/A], [C1, C2, C3, C4, M:P/A]) :-
	!,
	filter_list([P1,P2,P3,P4], VarList, [C1,C2,C3,C4], CurrForVarList),
	VarList = CurrForVarList.
unify_slots([P1, P2, P3, P4, P/A], [C1, C2, C3, C4, P/A]) :-
	!,
	filter_list([P1,P2,P3,P4], VarList, [C1,C2,C3,C4], CurrForVarList),
	VarList = CurrForVarList.
unify_slots(ParList, CurrList) :-
	filter_list(ParList, VarList, CurrList, CurrForVarList),
	VarList = CurrForVarList.

filter_list([], [], [], []).
filter_list([P | Ps], [P | Vs], [C | Cs], [C | Zs]) :-
	var(P),
	!,
	filter_list(Ps, Vs, Cs, Zs).
filter_list([P | Ps], Vs, [C | Cs], Zs) :-
	filter_list(Ps, Vs, Cs, Zs).

