/*
 * 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: display.op,v 1.1.1.1 2006/09/23 01:54:29 snovello Exp $
 *
 */

/*
 *	DISPLAY Scenario
 */
opium_scenario(
	name		: display,
	files		: [display, display_demos],
	scenarios	: [],
	message		:
 "Scenario which contains everything related to the display of trace \n\
lines.  In particular the slots to be displayed can be specified, as \n\
well as the way lists and terms are displayed. Arguments of predicates \n\
can be skipped. Many procedures allow you to customize the display."
	).


/* 
 *	PRINT-LINE
 */
opium_command(
	name		: print_line,
	arg_list	: [],
	arg_type_list	: [],
	abbrev		: p,
	interface	: button,
	command_type	: opium,
	implementation	: print_line_Op,
	parameters	: [indent_display, slot_display, 
				arg_undisplay, list_display, 
				term_display],
	message		:
"Command which prints the current trace line according to the value of the \n\
display parameters."
	).

print_line_Op :- 
	curr_line(Chrono, Call, Depth, Port, Module:Pred/Arity),
	curr_arg(Arg),
	slot_display(ChronoF,CallF,DepthF,PortF,ModuleF,PredF,ArgF,ArityF),
	indent_display(IndentF, IndentValue, IndentDepth),
	write_indent(IndentF, IndentValue, IndentDepth, Depth),
	print_line_slot(chrono, Chrono, ChronoF),
	print_line_slot(call,	Call,	CallF),
	print_line_slot(depth, 	Depth,	DepthF),
	print_line_slot(port, 	Port, 	PortF),
	print_line_slot(module, Module, ModuleF),
	print_goal(Pred/Arity, PredF, Arg, ArgF, Module),
	print_line_slot(arity, 	Arity,	ArityF),
	write_trace('\n'),
	!.

print_line_slot(SlotName, SlotValue, off).
print_line_slot(SlotName, SlotValue, on) :-
	write_slot(SlotName, SlotValue).

print_arg_slot(_, off, _, _).
print_arg_slot(Val, on, Pred, M) :-
	write_arg_slot(Val, Pred, M).

print_goal(Pred, off, Arg, off, M) :-
	!.
print_goal(Pred, on, Arg, on, M) :-
	!,
	write_goal(Pred, Arg, M).
print_goal(Pred/Arity, PredF, Arg, ArgF, M) :-
	print_line_slot(pred, Pred, PredF),
	print_arg_slot(Arg, ArgF, Pred/Arity, M).


/*
 *	INDENT
 */
opium_command(
	name		: indent,
	arg_list	: [OnOff],
	arg_type_list	: [is_member([on, off])],
	abbrev		: _,
	interface	: button,
	command_type	: opium,
	implementation	: indent_Op,
	parameters	: [indent_display],
	message		:
 "Command which sets the indentation on/off. If a tracing process is \n\
on it sets the depth at which the indentation has to start to the \n\
current depth. Otherwise the starting depth is 1."
	).

indent_Op(OnOff) :-
	traced_execution_running,
	!,
	curr_depth(Depth),
	indent_display(_, Value, _),
	set_parameter(indent_display, [OnOff, Value, Depth]).
indent_Op(OnOff) :-
	indent_display(_, Value, _),
	set_parameter(indent_display, [OnOff, Value, 1]).

/*
 *	ABSOLUTE-INDENT
 */
opium_command(
	name		: absolute_indent,
	arg_list	: [Depth],
	arg_type_list	: [integer],
	abbrev		: _,
	interface	: button,
	command_type	: opium,
	implementation	: absolute_indent_Op,
	parameters	: [indent_display],
	message		:
"Command which sets the indentation on, and sets the depth at which the \n\
indentation has to start to Depth."
	).

absolute_indent_Op(N) :-
	indent_display(_, Value, _),
	set_parameter(indent_display, [on, Value, N]).


/* 
 *	WRITE-INDENT 
 */
opium_procedure(
	name		: write_indent,
	arg_list	: [IndentFlag, IndentValue, IndentDepth, CurrDepth],
	implementation	: write_indent_Op,
	parameters	: [indent_display],
	message		:
 "Procedure which displays an indentation if indentation is on, and \n\
according to the current depth and the indentation stating depth. If \n\
IndentFlag is on, it prints N times IndentValue.  \n\
N is CurrDepth - IndentDepth if this is positive."
	).

write_indent_Op(off, V, IndentDepth, CurrDepth).
write_indent_Op(on, V, IndentDepth, CurrDepth) :- 
	Diff is CurrDepth - IndentDepth,
	Diff >= 0, 
	!,
	write_indentation(Diff, V).
write_indent_Op(on, V, IndentDepth, CurrDepth) :- 
	!.

write_indentation(N, V) :-
	indent_display_limit(Limit),
	N > Limit,
	!,
	write_spaces(Limit, V).
write_indentation(N, V) :-
	write_spaces(N, V).

write_spaces(0, V) :- !.
write_spaces(M, V) :-
	write_trace(V),
	M1 is M-1,
	write_spaces(M1, V).


/*
 *	WRITE-GOAL
 */
opium_procedure(
	name		: write_goal,
	arg_list	: [Pred, ArgList, Module],
	implementation	: write_goal_Op,
	parameters	: [arg_undisplay, term_display, list_display],
	message		:
 "Procedure which displays the goal. If you want to customize this \n\
procedure beware that if the predicate is an infix operator the goal \n\
should be displayed accordingly."
	).

write_goal_Op(Pred/2, [Arg1, Arg2], M) :-
	optype(Pred, infix),
	!,
	write_infix_arg(Arg1, 1, Pred/2, M),
	write_trace(Pred),
	write_infix_arg(Arg2, 2, Pred/2, M).
write_goal_Op(Pred/Arity, Arg, M) :-
	write_slot(pred, Pred),
	write_arg_slot(Arg, Pred/Arity, M).

write_infix_arg(Arg, N, Pred, M) :-
	var(Arg),
	!,
	write_without_parentheses(Arg, N, Pred, M).
write_infix_arg(Arg, N, Pred, M) :-
	atomic(Arg),
	!,
	write_without_parentheses(Arg, N, Pred, M).
write_infix_arg(Arg, N, Pred, M) :-
	Arg =.. [';' | A],
	!,
	write_within_parentheses(Arg, N, Pred, M).
write_infix_arg(Arg, N, Pred, M) :-
	write_without_parentheses(Arg, N, Pred, M).

write_within_parentheses(Arg, 1, Pred, M) :-
	write_trace('('),
	write_arguments([Arg], 1, Pred, M),
	write_trace(') ').
write_within_parentheses(Arg, 2, Pred, M) :-
	write_trace(' ('),
	write_arguments([Arg], 2, Pred, M),
	write_trace(')').

write_without_parentheses(Arg, 1, Pred, M) :-
	write_arguments([Arg], 1, Pred, M),
	write_trace(' ').
write_without_parentheses(Arg, 2, Pred, M) :-
	write_trace(' '),
	write_arguments([Arg], 2, Pred, M).


/*
 *	WRITE-SLOT
 */
opium_procedure(
	name		: write_slot,
	arg_list	: [SlotName, SlotValue],
	implementation	: write_slot_Op,
	parameters	: [slot_display],
	message		:
 "Procedure which displays a slot of the trace line. Where SlotName is \n\
one of {chrono, call, depth, port, module, arity}. To customize the \n\
way arguments are displayed you should rather modify write_arg_slot/3."
	).

write_slot_Op(chrono, V) :-
	write_trace(V),
	write_trace(' ').

write_slot_Op(call, V) :-
	write_trace(V).

write_slot_Op(depth, V) :-
	write_trace('['),
	write_trace(V),
	write_trace(']').

write_slot_Op(port, V) :-
	write_trace(' '),
	write_trace(V),
	write_trace(' ').

write_slot_Op(module, V) :-
	write_trace(V),
	write_trace(': ').

write_slot_Op(pred, V) :-
	write_trace(V).

write_slot_Op(arity, V) :-
	write_trace(' / '),
	write_trace(V).

/*
 *	WRITE-ARG-SLOT
 */
opium_procedure(
	name		: write_arg_slot,
	arg_list	: [ArgList, Pred, Module],
	implementation	: write_arg_slot_Op,
	parameters	: [slot_display],
	message		:
 "Procedure which displays the arguments of the trace line when the \n\
predicate is Pred. If only the nth argument of a predicate needs a \n\
special treatment customize write_nth_arg/4."
	).

write_arg_slot_Op([], P/A, M):- 
	!.
write_arg_slot_Op(V, P/A, M) :-
	write_trace('('),
	write_arguments(V, 1, P/A, M),
	write_trace(')').

write_arguments(Args, N, P/A, M) :-
	arguments_display(normal),
	!,
	write_args(Args, N, P/A, M).
write_arguments(Args, N, P/A, M) :-
	write_args_simple(Args).

/* write arguments in a simple way */

write_args_simple([Arg | T]) :-
	writeq_trace(Arg),
	write_tail_simple(T).

write_tail_simple(T) :-
	T == [],
	!.
write_tail_simple(T) :-
	write_comma,
	write_args_simple(T).

/* write arguments in the normal way */

write_args([Arg | T], N, P/A, M) :-
	write_nth_arg(Arg, N, P/A, M),
	write_tail(T, N, P/A, M).


/*
 *	WRITE-NTH-ARG
 */	
opium_procedure(
	name		: write_nth_arg,
	arg_list	: [Arg, N, Pred, Module],
	implementation	: write_nth_arg_Op,
	parameters	: [arguments_display, arg_undisplay, term_display, 
				list_display],
	message		:
"Procedure which displays the Nth argument of predicate Pred in Module."
	).

write_nth_arg_Op(Arg, N, P/A, M) :-
	arg_undisplay(M:P/A, N),	
	/* arg not to be displayed */
	!,
	write_ersatz.
write_nth_arg_Op(Arg, N, P/A, M) :-
	arg_undisplay(P/A, N),
	/* arg not to be displayed */
	!,
	write_ersatz.
write_nth_arg_Op(Arg, _, _, M) :-
	write_arg(Arg).

write_tail(T, N, P/A, M) :-
	T==[],
	!.
write_tail(T, N, P/A, M) :-
	N1 is N+1,
	write_comma,
	write_args(T, N1, P/A, M).


/*
 *	WRITE-ARG
 */
opium_procedure(
	name		: write_arg,
	arg_list	: [Arg],
	implementation	: write_arg_Op,
	parameters	: [term_display, list_display],
	message		:
"Procedure which prints an argument."
	).

write_arg_Op(A) :-
	var(A),
	!,
	write_trace(A).
write_arg_Op(A) :-
	atomic(A),
	!,
	writeq_trace(A).
write_arg_Op(-I) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_arg_Op([H | T]) :-
	!,
	write_list([H|T]).
write_arg_Op(A) :-
	write_term(A).


/*
 *	WRITE-TERM
 */
opium_procedure(
	name		: write_term,
	arg_list	: [Term],
	implementation	: write_term_Op,
	parameters	: [term_display],
	message		:
"Procedure which displays a structured term, taking into account the \n\
term_display parameter."
	).

/*  Variable last_op tells whether the last operator has been a  
 *  comma or any other operator. This is taken into account by 
 *  write_term_.../4 to ensure that (a,b,c) is printed in this way
 *  instead of (a, (b, c)).
 */
:- setval(last_op, any).

write_term_Op(T) :-
	term_display(DType, DN),
	write_term(T, DType, DN),
	setval(last_op, any).

write_term(Term, DType, DN) :-
	Term =.. [{} | [Arg]],
	!,
	write_trace('{'),
	write_arg(Arg),
	write_trace('}').
write_term(Term, DType, DN) :-
	functor(Term, Op, Arity),
	optype(Op, OpType),
	write_term(Term, Arity, OpType, DType, DN),
	!.
write_term(Term, DType, DN) :-
	functor(Term, Op, Arity),
	write_term(Term, Arity, prefix, DType, DN).

write_term(Term, Arity, OpType, normal, DN) :-
	write_term_normal(Term, Arity, OpType, DN).
write_term(Term, Arity, OpType, nest, DN) :-
	write_term_nest(Term, Arity, OpType, DN).
write_term(Term, Arity, OpType, truncate, DN) :-
	write_term_truncate(Term, Arity, OpType, DN).

/* print structured terms in normal way */

write_term_normal(Term, Arity, prefix, _) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_trace(Op),
	write_trace('('),
	write_args_normal_int(1, Arity, As),
	write_trace(')').
write_term_normal(Term, 2, infix, _) :-
	Term =.. [Op | As],
	Op = ',',
	getval(last_op, any),
	!,
	setval(last_op, comma),
	write_trace('('),
	write_args_normal_int(1, 1, As),
	write_trace(Op),
	write_trace(' '),
	write_args_normal_int(2, 2, As),
	write_trace(')').
write_term_normal(Term, 2, infix, _) :-
	Term =.. [Op | As],
	Op = ',',
	!,
	write_args_normal_int(1, 1, As),
	write_trace(Op),
	write_trace(' '),
	write_args_normal_int(2, 2, As).
write_term_normal(Term, 2, infix, _) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_args_normal_int(1, 1, As),
	write_trace(' '),
	write_trace(Op),
	write_trace(' '),
	write_args_normal_int(2, 2, As).
write_term_normal(Term, Arity, postfix, _) :-
	setval(last_op, any),
	Term =.. [Op | As],
	write_trace('('),
	write_args_normal_int(1, Arity, As),
	write_trace(')'),
	write_trace(Op).

write_args_normal_int(1, To, Args) :-
	!,
	write_n_args_normal(To, Args).
write_args_normal_int(From, To, [As | Args]) :-
	NF is From - 1,
	NT is To - 1,
	write_args_normal_int(NF, NT, Args).
	
write_n_args_normal(1, [Arg|_]) :-
	!,
	write_arg_normal(Arg).
write_n_args_normal(N, [Arg|As]) :-
	write_arg_normal(Arg),
	write_trace(', '),
	N0 is N - 1,
	write_n_args_normal(N0, As).

write_arg_normal(A) :-
	var(A),
	!,
	write_trace(A).
write_arg_normal(A) :-
	atomic(A),
	!,
	writeq_trace(A).
write_arg_normal(-I) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_arg_normal([H | T]) :-
	!,
	write_list([H|T]).
write_arg_normal(A) :-
	write_term(A).


/* print structured terms with limitation to nesting */

write_term_nest(_, _, _, 0) :-
	!,
	setval(last_op, any),
	write_ersatz.
write_term_nest(Term, Arity, prefix, L) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_trace(Op),
	write_trace('('),
	write_args_nest_int(1, Arity, As, L),
	write_trace(')').
write_term_nest(Term, 2, infix, L) :-
	Term =.. [Op | As],
	Op = ',',
	getval(last_op, any),
	!,
	setval(last_op, comma),
	write_trace('('),
	write_args_nest_int(1, 1, As, L),
	write_trace(Op),
	write_trace(' '),
	write_args_nest_int(2, 2, As, L),
	write_trace(')').
write_term_nest(Term, 2, infix, L) :-
	Term =.. [Op | As],
	Op = ',',
	!,
	write_args_nest_int(1, 1, As, L),
	write_trace(Op),
	write_trace(' '),
	write_args_nest_int(2, 2, As, L).
write_term_nest(Term, 2, infix, L) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_args_nest_int(1, 1, As, L),
	write_trace(' '),
	write_trace(Op),
	write_trace(' '),
	write_args_nest_int(2, 2, As, L).
write_term_nest(Term, Arity, postfix, L) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_trace('('),
	write_args_nest_int(1, Arity, As, L),
	write_trace(')'),
	write_trace(Op).

write_args_nest_int(1, To, Args, L) :-
	!,
	write_n_args_nest(To, Args, L).
write_args_nest_int(From, To, [As | Args], L) :-
	NF is From - 1,
	NT is To - 1,
	write_args_nest_int(NF, NT, Args, L).

write_n_args_nest(1, [Arg|_], L) :-
	!,
	write_arg_nest(Arg, L).
write_n_args_nest(N, [Arg|As], L) :-
	write_arg_nest(Arg, L),
	write_trace(', '),
	N0 is N - 1,
	write_n_args_nest(N0, As, L).

write_arg_nest(A, _) :-
	var(A),
	!,
	write_trace(A).
write_arg_nest(A, _) :-
	atomic(A),
	!,
	writeq_trace(A).
write_arg_nest(-I, _) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_arg_nest([H | T], N) :-
	!,
	N0 is N - 1,
	write_list([H|T]).
write_arg_nest(A, N) :-
	N0 is N - 1,
	write_term(A, nest, N0).


/* print structured terms in a truncated way */

write_term_truncate(_, _, _, 0) :-
	!,
	setval(last_op, any),
	write_ersatz.
write_term_truncate(Term, Arity, prefix, L) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_trace(Op),
	write_trace('('),
	write_args_truncate_int(1, Arity, As, L),
	write_trace(')').
write_term_truncate(Term, 2, infix, L) :-
	Term =.. [Op | As],
	Op = ',',
	getval(last_op, any),
	!,
	setval(last_op, comma),
	write_trace('('),
	write_args_truncate_int(1, 1, As, L),
	write_trace(Op),
	write_trace(' '),
	write_args_truncate_int(2, 2, As, L),
	write_trace(')').
write_term_truncate(Term, 2, infix, L) :-
	Term =.. [Op | As],
	Op = ',',
	!,
	write_args_truncate_int(1, 1, As, L),
	write_trace(Op),
	write_trace(' '),
	write_args_truncate_int(2, 2, As, L).
write_term_truncate(Term, 2, infix, L) :-
	!,
	setval(last_op, any),
	Term =.. [Op | As],
	write_args_truncate_int(1, 1, As, L),
	write_trace(' '),
	write_trace(Op),
	write_trace(' '),
	write_args_truncate_int(2, 2, As, L).
write_term_truncate(Term, Arity, postfix, L) :-
	setval(last_op, any),
	Term =.. [Op | As],
	write_trace('('),
	write_args_truncate_int(1, Arity, As, L),
	write_trace(')'),
	write_trace(Op).

write_args_truncate_int(1, To, Args, L) :-
	!,
	write_n_args_truncate(To, Args, L).
write_args_truncate_int(From, To, [As | Args], L) :-
	NF is From - 1,
	NT is To - 1,
	NL is L - 1,
	write_args_truncate_int(NF, NT, Args, NL).

write_n_args_truncate(N, Args, L) :-
	N > L,
	!,
	write_ersatz.
write_n_args_truncate(N, [Arg|_], L) :-
	!,
	write_arg_truncate(Arg, L).
write_n_args_truncate(N, [Arg|As], L) :-
	write_arg_truncate(Arg, L),
	write_trace(', '),
	N0 is N - 1,
	write_n_args_truncate(N0, As, L).

write_arg_truncate(A, _) :-
	var(A),
	!,
	write_trace(A).
write_arg_truncate(A, _) :-
	atomic(A),
	!,
	writeq_trace(A).
write_arg_truncate(-I, _) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_arg_truncate([H | T], L) :-
	!,
	write_list([H|T]).
write_arg_truncate(A, L) :-
	write_term(A, truncate, L).


/* 	
 *	WRITE-LIST
 */
opium_procedure(
	name		: write_list,
	arg_list	: [List],
	implementation	: write_list_Op,
	parameters	: [list_display],
	message		:
"Procedure which displays a list, taking into account the list_display \n\
parameter."
	).

write_list_Op(L) :-
	list_display(Type,  N),
	write_list_l(L, Type, N).

write_list_l(L, normal, _) :-
	write_normal_list_l(L).
write_list_l(L, nest, N) :-
	write_nest_list_l(L, 1, N).
write_list_l(L, truncate, N) :-
	write_truncate_list_l(L, N).

/* display lists in the normal way */

write_normal_list_l(L) :-
	write_trace('['),
	write_normal_elements_l(L),
	write_trace(']').

write_normal_elements_l([H|T]) :-
	write_normal_elements_i(H),
	write_normal_tail(T),
	!.
write_normal_elements_l(X) :-
	/* if list structure isn't proper */
	writeq_trace(X).

write_normal_elements_i(V) :-
	var(V),
	!,
	write_trace(V).
write_normal_elements_i(A) :-
	atomic(A),
	!,
	writeq_trace(A).
write_normal_elements_i(-I) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_normal_elements_i([H | T]) :-
	!,
	write_normal_list_l([H | T]).
write_normal_elements_i(A) :-
	write_term(A).

write_normal_tail(T) :-
	/* otherwise cyclic structures can be created */
	var(T),
	!,
	write_trace('|'),
	write_trace(T).
write_normal_tail(T) :-
 	T == [],
	!.
write_normal_tail([TH | TT]) :-
	/* tail is a proper list */	
	!,
	write_comma,
	write_normal_elements_l([TH | TT]).
write_normal_tail(T) :-
	write_trace('|'),
	write_trace(T).

/* display of lists with limit to nesting */

write_nest_list_l(L, N, Nest) :-
	write_trace('['),
	write_nest_list_els(L, N, Nest),
	write_trace(']').

write_nest_list_els(L, N, Nest) :-
	N > Nest,
	!,
	write_ersatz.
write_nest_list_els(L, N, Nest) :-
	write_nest_elements_l(L, N, Nest).

write_nest_elements_l([H|T], N, Nest) :-
	write_nest_elements_i(H, N, Nest),
	write_nest_tail(T, N, Nest),
	!.
write_nest_elements_l(X, N, Nest) :-
	/* if list structure isn't proper */
	writeq_trace(X).

write_nest_elements_i(V, _, _) :-
	var(V),
	!,
	write_trace(V).
write_nest_elements_i(A, _, _) :-
	atomic(A),
	!,
	writeq_trace(A).
write_nest_elements_i(-I, _, _) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_nest_elements_i([H | T], N, Nest) :-	
	!,
	N1 is N + 1,
	write_nest_list_l([H | T], N1, Nest).
write_nest_elements_i(A, _, _) :-
	write_term(A).

write_nest_tail(T, _, _) :-
	/* otherwise cyclic structures can be created */
	var(T),
	!,
	write_trace('|'),
	write_trace(T).
write_nest_tail(T, N, Nest) :-
	T == [],
	!.
write_nest_tail([TH | TT], N, Nest) :-
	/* tail is a proper list */	
	!,
	write_comma,
	write_nest_elements_l([TH | TT], N, Nest).
write_nest_tail(T, N, Nest) :-
	write_trace('|'),
	write_trace(T).


/* truncated display of lists ie. only the Nth first elements */

write_truncate_list_l(L, Trunc) :-
	write_trace('['),
	write_truncate_elements_l(L, 0, Trunc),
	write_trace(']').

write_truncate_elements_l([H|T], N, Trunc) :-
 	N >= Trunc,
	!,
	write_ersatz.
write_truncate_elements_l([H|T], N, Trunc) :-
	write_truncate_elements_i(H, Trunc),
	write_truncate_tail(T, N, Trunc).
write_truncate_elements_l(X, N, Trunc) :-
	/* if list structure isn't proper */
	writeq_trace(X).

write_truncate_elements_i(V, _) :-
	var(V),
	!,
	write_trace(V).
write_truncate_elements_i(A, _) :-
	atomic(A),
	!,
	writeq_trace(A).
write_truncate_elements_i(-I, _) :-
	integer(I),
	!,
	write_trace('-'),
	write_trace(I).
write_truncate_elements_i([H|T], Trunc) :-
	!,					
	write_truncate_list_l([H|T], Trunc).
write_truncate_elements_i(A, _) :-
	write_term(A).

write_truncate_tail(T, _, _) :-
	/* otherwise cyclic structures can be created */
	var(T),
	!,
	write_trace('|'),
	write_trace(T).
write_truncate_tail(T, N, Trunc) :-
	T==[],
	!.
write_truncate_tail([TH | TT], N, Trunc) :-
	/* tail is a proper list */	
	!,
	write_comma,
	N1 is N+1,
	write_truncate_elements_l([TH | TT], N1, Trunc).
write_truncate_tail(T, N, Trunc) :-
	write_trace('|'),
	write_trace(T).



/*	
 *	WRITE-ERSATZ	
 */
opium_procedure(
	name		: write_ersatz,
	arg_list	: [],
	implementation	: write_ersatz_Op,
	parameters	: [],
	message		:
"Procedure which writes \"...\" as a replacement for the hidden parts of the \n\
arguments."
	).

write_ersatz_Op :-
	write_trace('...').

/* 	
 *	WRITE-COMMA	
 */
opium_procedure(
	name		: write_comma,
	arg_list	: [],
	implementation	: write_comma_Op,
	parameters	: [],
	message		:
"Procedure which writes \", \"."
	).

write_comma_Op :- 
	write_trace(', ').


/*
 *  write_trace/1
 */
write_trace(X) :-
	opium_write(trace, X).

/*
 *  writeq_trace/1
 */
writeq_trace(X) :-
	opium_printf(trace, "%Qw", [X]).



/* 	
 *	SLOT-DISPLAY
 */
opium_parameter(
	name		: slot_display,
	arg_list	: [Chrono, Call, Depth, Port, Module, Pred, Arg, Arity],
	arg_type_list	: [is_member([on,off]), is_member([on,off]),
				is_member([on,off]), is_member([on,off]),
				is_member([on,off]), is_member([on,off]), 
				is_member([on,off]), is_member([on,off])],
	parameter_type	: single,
	default		: [off, on, on, on, on, on, on, off],
	commands	: [print_line],
	message		: 
"Parameter which contains the flags for the selective display of slots. If \n\
the value of one argument is \"on\" then the corresponding slot is displayed."
	).

/*
 *	ARGUMENTS-DISPLAY
 */
opium_parameter(
	name		: arguments_display,
	arg_list	: [Type],
	arg_type_list	: [is_member([normal, simple])],
	parameter_type	: single,
	default		: [normal],
	commands	: [write_arg],
	message		: 
"Parameter which tells how arguments shall be displayed. If Type is \"simple\", \n\
then arguments are displayed without taking the list_display and term_display \n\
parameters into account."
	).

/* 	
 *	LIST-DISPLAY
 */
opium_parameter(
	name		: list_display,
	arg_list	: [Type, Range],
	arg_type_list	: [is_member([normal, nest, truncate]), integer],
	parameter_type	: single,
	default		: [normal, 0],
	commands	: [select_list_display, write_list],
	message		: 
"Parameter which tells how lists shall be displayed. If Type is \"normal\", \n\
lists are displayed in the standard Prolog way. If Type is \"nest\", \n\
the nested lists are displayed only till level Range (included). If Type is \n\
\"truncate\", only the first Range elements of the lists are displayed."
	).

/* 	
 *	TERM-DISPLAY	
 */
opium_parameter(
	name		: term_display,
	arg_list	: [Type, Range],
	arg_type_list	: [is_member([normal, nest, truncate]), integer],
	parameter_type	: single,
	default		: [normal, 0],
	commands	: [write_term],
	message		: 
"Parameter which tells how structured terms shall be displayed. If Type is \n\
\"normal\", terms are displayed in the standard Prolog way. If Type is \"nest\", \n\
the nested terms are displayed only till level Range (included). If Type is \n\
\"truncate\", only the first Range elements of the term are displayed."
	).

/* 	
 *	INDENT-DISPLAY
 */
opium_parameter(
	name		: indent_display,
	arg_list	: [OnOff, IndentationValue, Depth],
	arg_type_list	: [is_member([on, off]), atomic, integer],
	parameter_type	: single,
	default		: [off, '  ', 1],
	commands	: [print_line, write_indent],
	message		: 
"Paramater which tells whether indentation is \"on\" or \"off\", what has to be \n\
printed as indentation value, and at which depth the indentation has to be \n\
started." 
	).

/*
 *	INDENT-DISPLAY-LIMIT
 */
opium_parameter(
	name		: indent_display_limit,
	arg_list	: [IndentLimit],
	arg_type_list	: [integer],
	parameter_type	: single,
	default		: [30],
	commands	: [write_indent],
	message		: 
"Parameter which tells up to which depth the trace lines shall be indented."
	).


/*	
 *	ARG-UNDISPLAY-FLAG	
 */
opium_parameter(
	name		: arg_undisplay,
	arg_list	: [Pred, ArgNo],
	arg_type_list	: [is_pred, integer],
	parameter_type	: multiple,
	default		: nodefault,
	commands	: [write_arg],
	message		: 
"Parameter which tells which arguments of which predicates have to be NOT \n\
displayed. There must be one \"arg_undisplay\" clause for each argument which \n\
shall not be displayed." 
	).




/*
 *  optype/2
 */
optype(Op, OpType) :-
	/* standard Sepia operators */
	current_op(P, A, Op),
	get_optype(A, OpType).

get_optype(yfx, infix)   :- !.
get_optype(xfy, infix)   :- !.
get_optype(xfx, infix)   :- !.
get_optype(xf,  postfix) :- !.
get_optype(yf,  postfix) :- !.
get_optype(fx,  prefix)  :- !.
get_optype(fy,  prefix)  :- !.





