mercury/extras/morphine/source/current_arg.op

%------------------------------------------------------------------------------%
% Copyright (C) 1999,2001 INRIA/INSA de Rennes.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file License in the Morphine distribution.
%
% Author : Erwan Jahier <jahier@irisa.fr>
%
% This file implements all the predicates that deal with variables retrieval.




%------------------------------------------------------------------------------%
opium_primitive(
	name		: current_arg,
	arg_list	: [ArgumentList],
	arg_type_list	: [is_list_or_var],
	abbrev		: _,
	implementation	: current_arg_Op,
	message		:
"Gets or checks the values of the currently live arguments of the current \
event.  Unifies non-live arguments with the atom '-'.\n\
Example: if the first argument of the current procedure is 2, the second is \
`[4, 6]' and the third is not live, `current_arg(Arg)' unifies `Arg' with the \
list `[2, [4, 6], -]'.\n\
\n\
If you do not want to retrieve an argument (because it is very big for \
example), you can use the atom '-': for example, `current_arg([X, -, -])' \
only retrieves the first argument of the current procedure."
	).

current_arg_Op(Arg) :-
	current(arity = Arity),
	(
		free(Arg),
		current_vars(ListLiveArg, _),
		generate_list_arg(0, Arity, ListLiveArg, Arg),
		!
	;
		is_list(Arg),
		% for example if Arg = [-,-,X,-,Y,-], we retrieve the argument 
		% one by one (which is stupid if we have [X1, X2, X3] ...).
		length(Arg, Length),
		(
			Arity == Length
		->
			current_live_var_names_and_types_ll(ListVarNames, _),
			retrieve_one_by_one(ListVarNames, 1, Arg)
		;
			% for example if Arg = [X | _]
			current_vars(ListLiveArg, _),
			generate_list_arg(0, Arity, ListLiveArg, Arg),
			!
		)
	).


retrieve_one_by_one(ListVarNames, N, [Arg | TailArg]) :-
	(
		Arg == '-',
		!
	;
		integer_to_headvar(N, HeadVar__N),
		current_live_var2(ListVarNames, HeadVar__N, RetrievedArg, _, _),
		Arg = RetrievedArg
	),
	N1 is N + 1,
	retrieve_one_by_one(ListVarNames, N1, TailArg).

retrieve_one_by_one(_, _, []).


% :- type live_var --->
% 	live_var(
% 		string,	% variable name
% 		T,	% Variable value
% 		string  % variable type
% 		).

%:- pred generate_list_arg(int, int, list(live_var), list(T)).
%:- mode generate_list_arg(in, in, out, out) is det.
	% This predicate take a list of live_var and outputs the list of the 
	% current predicate arguments where non live arguments are replaced 
	% by '-'.
	% Ex: generate_list_arg(0, 3, [live_var("HeadVar2", 4, int)], [-, 4, -]).
generate_list_arg(Max, Max, _, []) :-
	!.

generate_list_arg(N, Max, ListVar, [NewVar | NewTail]) :-
	NN is N + 1,
	( 
		integer_to_headvar(NN, VarName),
		member(live_var(VarName, Value, _Type), ListVar)
	->
		NewVar = Value,
		generate_list_arg(NN, Max, ListVar, NewTail)
	;
		NewVar = '-',
		generate_list_arg(NN, Max, ListVar, NewTail)
	).

%:- pred headvar_to_integer(string, integer).
%:- mode headvar_to_integer(in, out) is semidet.
	% Internal name of arguments of the current predicate are of the form
	% "HeadVar__i". This predicate converts it into an integer.
	% Example: headvar_to_integer(HeadVar__3, 3).
headvar_to_integer(HeadVar, Int) :-
	append_strings("HeadVar__", IntStr, HeadVar),
	number_string(Int, IntStr).

integer_to_headvar(Int, HeadVar) :-
	number_string(Int, IntStr),
	append_strings("HeadVar__", IntStr, HeadVar).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: current_arg_names,
	arg_list	: [ListArgNames],
	arg_type_list	: [is_list_or_var],
	abbrev		: _,
	implementation	: current_arg_names_Op,
	message		:
"Gets or checks the list of names of the current procedure arguments. \
Unifies non-live arguments with the atom '-'."
	).

current_arg_names_Op(ListArgNames) :-
	current_live_var_names_and_types(LVN),
	current(arity = Arity),
	generate_list_arg_names(0, Arity, LVN, ListArgNames).

generate_list_arg_names(Max, Max, _, []) :-
	!.

generate_list_arg_names(N, Max, ListVar, [NewVarName | NewTail]) :-
	NN is N + 1,
	( 
		integer_to_headvar(NN, VarName),
		member(live_var_names_and_types(VarName, _), ListVar)
	->
		NewVarName = VarName,
		generate_list_arg_names(NN, Max, ListVar, NewTail)
	;
		NewVarName = '-',
		generate_list_arg_names(NN, Max, ListVar, NewTail)
	).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: current_arg_types,
	arg_list	: [ListArgTypes],
	arg_type_list	: [is_list_or_var],
	abbrev		: _,
	implementation	: current_arg_types_Op,
	message		:
"Gets or checks the list of arguments types of the current procedure. \
Unifies non-live arguments types with the atom '-'."
	).

current_arg_types_Op(ListArgTypes) :-
	current_live_var_names_and_types(LVN),
	current(arity = Arity),
	generate_list_arg_types(0, Arity, LVN, ListArgTypes).

generate_list_arg_types(Max, Max, _, []) :-
	!.

generate_list_arg_types(N, Max, ListVar, [NewVarType | NewTail]) :-
	NN is N + 1,
	( 
		integer_to_headvar(NN, VarName),
		member(live_var_names_and_types(VarName, VarType), ListVar)
	->
		NewVarType = VarType,
		generate_list_arg_types(NN, Max, ListVar, NewTail)
	;
		NewVarType = '-',
		generate_list_arg_types(NN, Max, ListVar, NewTail)
	).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: current_vars,
	arg_list	: [LiveArgList, OtherLiveVarList],
	arg_type_list	: [is_list_or_var, is_list_or_var],
	abbrev		: _,
	implementation	: current_vars_Op,
	message		:
"Gets or checks the values of the currently live (*) variables of the \
current event. These variables are separated in two lists: one containing the \
live arguments of the current predicate, one containing other currently live \
variables.\n\
\n\
(*) We say that a variable is live at a given point of the execution if it has \
been instantiated and if the result of that instantiation is still available \
(which is not the case for destructively updated variables).\
"
	).

% :- pred current_vars(list(live_var), list(live_var)).
% :- mode current_vars(out, out) is det.
% :- mode current_vars(in, out) is semidet.
% :- mode current_vars(out, in) is semidet.
% :- mode current_vars(in ,in) is semidet.
current_vars_Op(ListLiveArg, ListOtherLiveVar) :-
	( 
		(
			not(free(ListOtherLiveVar)),
			ListOtherLiveVar = '-'
		;
			not(free(ListOtherLiveVar)),
			ListOtherLiveVar = '-'
		)
		% We retrieve the information about arguments only if it 
		% is needed.
	->
		true
	;
		current_vars2(ListLiveArgRetrieved, ListOtherLiveVarRetrieved),
		ListLiveArg = ListLiveArgRetrieved,
		ListOtherLiveVar = ListOtherLiveVarRetrieved
	).


%:- pred current_vars2(list(live_var), list(live_var)).
%:- mode current_vars2(out, out) is det.
current_vars2(ListLiveArgRetrieved, ListOtherLiveVarRetrieved) :-
	current_vars_ll(ListLiveVar, ListName),
	% The Mercury side send us all the live variables so we separate 
	% here the live variables that are arguments of the current 
	% predicate (which internal name is of the form "HeadVar__i") from 
	% the other live variables.
	current_live_var_names_and_types_ll(_, ListVarType),
	split_list_of_live_args_and_vars(ListVarType, ListName, 
		ListArgType, _, ListOtherVarType, _),
	split_list_of_live_args_and_vars(ListLiveVar, ListName, 
		ListArg, ListArgName, ListOtherVar, ListOtherVarName),
	synthetise_list_univ_and_list_string(ListOtherVar, ListOtherVarName, 
		ListOtherVarType, ListOtherLiveVarRetrieved),
	synthetise_list_univ_and_list_string(ListArg, ListArgName, 
		ListArgType, ListLiveArgRetrieved).


%:- pred split_list_of_live_args_and_vars(list(univ), list(string), 
%	list(univ), list(string), list(univ), list(string) ).
%:- mode split_list_of_live_args_and_vars(in, in, out, out, out, out) is det.
	% Splits live arguments from other live variables. 
	% split_list_of_live_args_and_vars(L1, L2, L3, L4, L5, L6)
	% splits the elements of the lists in input (L1 and L2) into L3, L4 and
	% L5, L6 respectively. L2 contains Mercury variable internal names;
	% for names beginning with "HeadVar__", the corresponding elements
	% of L1 and L2 are put in L3 and L5; otherwise, they are put in L4 
	% and L6.
split_list_of_live_args_and_vars([], [], [], [], [], []).
split_list_of_live_args_and_vars([Var | TailVar], [VarName | TailVarName],
		ListArg, ListArgName, ListOtherVar , ListOtherVarName) :-
	split_list_of_live_args_and_vars(TailVar, TailVarName, 
		TailListArg, TailListArgName, 
		TailListOtherVar, TailListOtherVarName),
	( append_strings("HeadVar__", _, VarName) ->
		append([Var], TailListArg, ListArg),
		append([VarName], TailListArgName, ListArgName),
		ListOtherVar = TailListOtherVar,
		ListOtherVarName = TailListOtherVarName
	;
		ListArg = TailListArg,
		ListArgName = TailListArgName,
		append([Var], TailListOtherVar, ListOtherVar),
		append([VarName], TailListOtherVarName, ListOtherVarName)
	).

%:- pred synthetise_list_univ_and_list_string(list(univ), list(string), 
%	list(live_var) ).
%:- mode synthetise_list_univ_and_list_string(in, in, out) is det.
	% Take a list of univ and a list of string of the same size and 
	% synthetize it into a list of live_var. 

synthetise_list_univ_and_list_string(UnivList, VarNameList, VarTypeList, 
    Lout) :-
	(
		synthetise_list_univ_and_list_string2(UnivList, VarNameList, 
		        VarTypeList,  Lout),
		!
	;
		write("\nSoftware error in Morphine: "),
		write("synthetise_list_univ_and_list_string failed.\n"),
		abort
	).

synthetise_list_univ_and_list_string2(X, [Name | TailName], 
    [TypeStr|TailType], ListArgLive) :-
	(
	        X = [univ_cons(Arg) | TailArg],
	        !
	;
	        X = [_| TailArg],
	        Arg = 'error',
	        write("\n***** Can't retrieve that type of argument. "),
	        write("This is probably a bug in Morphine...\n")
	 ),
	synthetise_list_univ_and_list_string2(TailArg, TailName, TailType,
	     ListArgLeft),
	term_string(Type, TypeStr),
	ListArgLive = [live_var(Name, Arg, Type) | ListArgLeft].

synthetise_list_univ_and_list_string2([], [], [], []).

% :- pred current_vars_ll(list(univ), list(string)).
% :- mode current_vars_ll(out, out) is det.
	% Retrieve the list of currently live variables and the list of their 
	% internal name.
current_vars_ll(ListLiveVar, ListName) :-
	send_message_to_socket(current_vars),
	read_message_from_socket(Response),
	Response = response_current_vars(ListLiveVar, ListName).


%------------------------------------------------------------------------------%
opium_command(
	name		: current_live_var,
	arg_list	: [VarId, VarValue, VarType],
	arg_type_list	: [is_string_or_integer_or_var, is_term, 
				is_atom_or_var],
	abbrev		: clv,
	interface	: menu,
	command_type	: opium,
	implementation	: current_live_var_Op,
	parameters	: [],
	message		:
"Gets or checks the name, the value and the type of the currently live \
variables. `VarId' can be a string representing the variable name or, if it is \
an argument of the current procedure, an integer representing the rank the \
argument.\n\
Example: \
`current_live_var(\"HeadVar__3\", VarValue, _Type)' (or equivalently \
`current_live_var(3, VarValue, _Type)') binds `VarValue' with the \
current value of the third argument of the current predicate if it exists \
and if it is live, fails otherwise. \
You can get all the live variables by querying \
`current_live_var(VarId, VarValue, VarType)' and typing `;' at the prompt to \
search for other solutions. \
You can also get the list of all the currently live variables of type `int' \
with the Morphine query \
`setof((Name, Value), current_live_var(Name, Value, int), List)'.\
"
	).


% :- pred current_live_var(string_or_integer, atom).
% :- mode current_live_var(in, out) is semidet.
current_live_var_Op(VarId, VarValue, VarType) :-
	( integer(VarId) ->
		integer_to_headvar(VarId, VarName)
	;
		VarName = VarId
	),
	current_live_var_names_and_types_ll(ListVarNames, ListVarTypes),
	current_live_var2(ListVarNames, ListVarTypes, VarName, VarValue, 
	        VarType).


current_live_var2(ListVarNames, ListVarTypes, VarName, Value, Type) :-
	member(VarName, ListVarNames),
	get_internal_number(VarName, ListVarNames, InternalNumber),
	current_nth_var_ll(InternalNumber, X),
	get_type_from_list_vars(VarName, ListVarNames, ListVarTypes, Type),
	X = univ_cons(Value).

% :- pred get_type_from_list_vars(string, list(string), list(string), string).
% :- mode get_type_from_list_vars(in, in, in, out) is det.
	% if ListVarNames is a list of variable names and ListVarTypes is the
	% list of their corresponding type (in the same order), then
	% get_type_from_list_vars(VarName, ListVarNames, ListVarTypes, Type) 
	% outputs in Type the type of VarName.
get_type_from_list_vars(Name, [VarName|TVarName], [VarType|TVarType], Type) :-
	( Name = VarName ->
	        term_string(Type, VarType)
	; 
	        get_type_from_list_vars(Name, TVarName, TVarType, Type)
	).
get_type_from_list_vars(_, [], [], 'bad_type').
	% Should never occur.

get_internal_number(VarNames, ListVarNames, InternalNumber) :-	
	% This predicate unifies InternalNumber with the rank of VarNames in 
	% ListVarNames - 1.
	get_internal_number(1, VarNames, ListVarNames, InternalNumber).


get_internal_number(N, VarNames, [VarNames | _], N) :- !.
get_internal_number(N, VarNames, [_ | ListVarNames], InternalNumber) :-
	NN is N + 1,
	get_internal_number(NN, VarNames, ListVarNames, InternalNumber).

% :- pred current_nth_var_ll(int, univ).
% :- mode current_nth_var_ll(in, out) is det.
current_nth_var_ll(VarInternalNumber, Var) :-
	send_message_to_socket(current_nth_var(VarInternalNumber)),
	read_message_from_socket(Response),
	Response = response_current_nth_var(Var).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: current_live_var_names_and_types,
	arg_list	: [ListVarNames],
	arg_type_list	: [is_list_or_var],
	abbrev		: _,
	implementation	: current_live_var_names_and_types_Op,
	message		:
"Gets or checks the list of names and types of the currently live variables. \
Each live variable is a term of the form \
`live_var_names_and_types(VariableName, TypeOfTheVariable)'.\
"
	).


% :- pred current_live_var_names_and_types(list(string)).
% :- mode current_live_var_names_and_types(out) is det.
current_live_var_names_and_types_Op(SynthetisedList) :-
	current_live_var_names_and_types_ll(ListVarNames, ListType),
	synthetise_var_names_list_and_type_list(ListVarNames, ListType, 
		SynthetisedList).


% :- type live_var_names_and_types --->
% 	live_var_names_and_types(
% 		int,	% internal variable representation 
% 		string,	% Variable name
% 		string  % variable type
% 		).

%:- pred synthetise_var_names_list_and_type_list(
%	list(string), list(string), list(live_var_names_and_types)).
%:- mode synthetise_var_names_list_and_type_list(in, in, out) is det.
	% Merge the list of variables names and their type.
synthetise_var_names_list_and_type_list([], [], []).
synthetise_var_names_list_and_type_list([Var | TailVar], [Type | TailType], 
		[Hout | Tout]) :-
	Hout = live_var_names_and_types(Var, Type),
	synthetise_var_names_list_and_type_list(TailVar, TailType, Tout).

% :- pred current_live_var_names_and_types_ll(list(string), list(string)).
% :- mode current_live_var_names_and_types_ll(out, out) is det.
	% Outputs the list of the internal names of the currently live variables
	% and a list of their corresponding types.
current_live_var_names_and_types_ll(ListVarNames, ListType) :-
	send_message_to_socket(current_live_var_names),
	read_message_from_socket(Response),
	Response = response_current_live_var_names(ListVarNames, ListType).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: current_live_var_names_and_types,
	arg_list	: [],
	arg_type_list	: [],
	abbrev		: _,
	implementation	: current_live_var_names_and_types_Op,
	message		:
"Gets and displays the live variable names and types. You can change this \
display by customizing the procedure `display_list_var_names/0'.\
"
	).

current_live_var_names_and_types_Op :-
	current_live_var_names_and_types(List),
	write(user, "Current live variable names are: \n"),
	display_list_var_names(List),
	flush(user).


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