%------------------------------------------------------------------------------% % Copyright (C) 1999-2001 INRIA/INSA de Rennes/IFSIC. % 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 % opium_scenario( name : display, files : [display], scenarios : [], message : "Scenario which contains everything related to the display of trace \ events. In particular the attributes to be displayed can be specified, as \ well as the way lists and terms are displayed. Arguments of predicates \ can be skipped. Many procedures allow you to customize the display.\ " ). %------------------------------------------------------------------------------% opium_command( name : print_event, arg_list : [], arg_type_list : [], abbrev : p, interface : button, command_type : opium, implementation : print_event_Op, parameters : [indent_display, attribute_display, arg_undisplay, list_display, term_display], message : "Prints the current trace event according to the value of the \ display parameters. The name of the printed attributes can be get with the \ command `print_displayed_attributes/0'.\ " ). % :- pred print_event is det. print_event_Op :- ( getval(state_of_morphine, running) -> attribute_display(ChronoFlag, CallFlag, PortFlag, DepthFlag, DeterFlag, PredOrFuncFlag, DeclModuleFlag, DefModuleFlag, NameFlag, ArityFlag, ModeNumFlag, ArgFlag, ListVarFlag, TypeFlag, GoalPathFlag, LineNumberFlag), current_attributes(Chrono, Call, Depth, Port, PredOrFunc, DeclModule, DefModule, Name, Arity, ModeNum, Deter, GoalPath, LineNumber), indent_display(IndentFlag, IndentValue, IndentDepth), print_line_attribute(chrono, Chrono, ChronoFlag), write_indent(IndentFlag, IndentValue, IndentDepth, Depth), print_line_attribute(call, Call, CallFlag), print_line_attribute(depth, Depth, DepthFlag), print_line_attribute(port, Port, PortFlag), print_line_attribute(deter, Deter, DeterFlag), print_line_attribute(proc_type, PredOrFunc, PredOrFuncFlag), print_line_attribute(def_module, DefModule, DefModuleFlag), print_line_attribute(decl_module, DeclModule, DeclModuleFlag), print_line_attribute(name, Name, NameFlag), ( (ArgFlag = 'on' ; ListVarFlag = 'on' ; TypeFlag = 'on') -> % This is to turn around the fact that Mireille redefine of % precedence of 400 for the operator`:', which prevents % variables of the form: `e-g:foo' to unify with `Arg:Type'. current_op(Precedence, Assoc, ':'), op(600, xfy, ':'), % We only retrieve live variable if they are needed ( current_vars(ListArg, ListVar) -> write_arg_attribute(DeclModule:Name/Arity-ModeNum, ListArg, ArgFlag, TypeFlag) ; % sometimes, current_vars fails..., write_trace("(*** Software Error in current_vars/2)") ), op(Precedence, Assoc, ':') ; write_trace("()") ), print_line_attribute(arity, Arity, ArityFlag), print_line_attribute(mode_number, ModeNum, ModeNumFlag), print_line_attribute(goal_path, GoalPath, GoalPathFlag), print_line_attribute(line_number, LineNumber, LineNumberFlag), print_line_attribute(listvar, ListVar, ListVarFlag), write_trace('\n') ; write("You can't print any trace line; No program is running.\n") ),!. print_event_Op :- write("Sofware error in scenario display.op: print_event/0 failed.\n"). %:- pred print_line_attribute(atom, atom ,atom). %:- mode print_line_attribute(in, in, in) is det. print_line_attribute(_AttributeName, _AttributeValue, off). print_line_attribute(AttributeName, AttributeValue, on) :- write_attribute(AttributeName, AttributeValue). %------------------------------------------------------------------------------% opium_command( name : print_displayed_attributes, arg_list : [], arg_type_list : [], abbrev : _, interface : hidden, command_type : opium, implementation : print_displayed_attributes_Op, parameters : [indent_display, attribute_display, arg_undisplay, list_display, term_display], message : "Prints the names of the attributes displayed by `print_event/0'.\ " ). % :- pred print_displayed_attributes_Op is det. print_displayed_attributes_Op :- attribute_display(ChronoFlag, CallFlag, PortFlag, DepthFlag, DeterFlag, PredOrFuncFlag, DeclModuleFlag, DefModuleFlag, NameFlag, ArityFlag, ModeNumFlag, ArgFlag, ListVarFlag, TypeFlag, GoalPathFlag, LineNumFlag), indent_display(IndentFlag, IndentValue, IndentDepth), (ChronoFlag = on -> write_trace("chrono: ") ; true), write_indent(IndentFlag, IndentValue, IndentDepth, 1), print_line_attribute(call, call, CallFlag), print_line_attribute(depth, depth, DepthFlag), print_line_attribute(port, port, PortFlag), print_line_attribute(deter, deter, DeterFlag), print_line_attribute(proc_type, PredOrFunc, PredOrFuncFlag), print_line_attribute(def_module, Defmodule, DefModuleFlag), print_line_attribute(decl_module, Declmodule, DeclModuleFlag), print_line_attribute(name, name, NameFlag), ( ArgFlag = on -> write_trace("(arg)") ; write_trace(" ") ), print_line_attribute(arity, arity, ArityFlag), print_line_attribute(mode_number, mode_number, ModeNumFlag), print_line_attribute(goal_path, goal_path, GoalPathFlag), print_line_attribute(line_number, line_number, LineNumberFlag), write_trace('\n'), print_line_attribute(listvar, listvar, ListVarFlag), !. %------------------------------------------------------------------------------% opium_command( name : print_full_event, arg_list : [], arg_type_list : [], abbrev : pf, interface : hidden, command_type : opium, implementation : print_full_event_Op, parameters : [indent_display, arg_undisplay, list_display, term_display], message : "Prints the current trace event with all the attributes on.\ " ). % :- pred print_full_event is det. print_full_event_Op :- get_parameter(attribute_display, L), set_parameter(attribute_display, [on, on, on, on, on, on, on, on, on, on, on, on, on, on, on, on]), print_event_Op, set_parameter(attribute_display, L). %------------------------------------------------------------------------------% opium_command( name : print_full_displayed_attributes, arg_list : [], arg_type_list : [], abbrev : _, interface : hidden, command_type : opium, implementation : print_full_displayed_attributes_Op, parameters : [indent_display, attribute_display, arg_undisplay, list_display, term_display], message : "Prints the names of the attributes printed by `print_full_event/0'." ). % :- pred print_full_displayed_attributes_Op is det. print_full_displayed_attributes_Op :- indent_display(IndentFlag, IndentValue, IndentDepth), write_trace("chrono: "), write_indent(IndentFlag, IndentValue, IndentDepth, 1), print_line_attribute(call, call, on), print_line_attribute(depth, depth, on), print_line_attribute(port, port, on), print_line_attribute(deter, deter, on), print_line_attribute(proc_type, proc_type, on), print_line_attribute(def_module, def_module, on), print_line_attribute(decl_module, decl_module, on), print_line_attribute(name, name, on), write_trace("(arg)"), print_line_attribute(arity, arity, on), print_line_attribute(mode_number, mode_number, on), print_line_attribute(goal_path, goal_path, on), print_line_attribute(line_number, line_number, on), write_trace('\n'), !. %------------------------------------------------------------------------------% 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 : "Sets relative indentation on/off. If a tracing process is \ on, it sets the depth at which the indentation has to start to the \ current depth. Otherwise the starting depth is 1.\ " ). %:- pred indent(on_off). %:- mode indent(in) is det. indent_Op(OnOff) :- current(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]). %------------------------------------------------------------------------------% 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 : "Sets the indentation on and sets the depth at which the \ indentation has to start to `Depth'.\ " ). %:- pred absolute_indent_Op(integer). %:- mode absolute_indent_Op(in) is det. absolute_indent_Op(N) :- indent_display(_, Value, _), set_parameter(indent_display, [on, Value, N]). %------------------------------------------------------------------------------% opium_procedure( name : write_indent, arg_list : [IndentFlag, IndentValue, IndentDepth, CurrDepth], implementation : write_indent_Op, parameters : [indent_display], message : "Displays an indentation -- if indentation is on -- \ according to the current depth and the indentation starting depth. If \ `IndentFlag' is set to `on', it prints `N' times `IndentValue', where `N' is \ `CurrDepth - IndentDepth' if this is positive, 1 otherwise.\ " ). %:- pred write_indent_Op(atom, atom, atom, atom). %:- mode write_indent_Op(in, in, in, in) is det. 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) :- !. %:- pred write_indentation(integer, string). %:- mode write_indentation(in, in) is det. write_indentation(N, V) :- indent_display_limit(Limit), N > Limit, !, write_spaces(Limit, V). write_indentation(N, V) :- write_spaces(N, V). %:- pred write_spaces(integer, string). %:- mode write_spaces(in, in) is det. write_spaces(0, _V) :- !. write_spaces(M, V) :- write_trace(V), M1 is M-1, write_spaces(M1, V). %------------------------------------------------------------------------------% opium_procedure( name : write_attribute, arg_list : [AttributeName, AttributeValue], implementation : write_attribute_Op, parameters : [attribute_display], message : "Displays an attribute of the trace line. `AttributeName' is \ a member of the following list: [chrono, call, depth, port, proc_type, \ decl_module, def_module, arity, mode_number, args, deter, goal_path, \ line_number, non_arg_var]. To customize the way arguments are displayed, you \ should rather modify `write_arg/1'." ). %:- pred write_attribute_Op(atom, atom). %:- mode write_attribute_Op(in, in) is det. write_attribute_Op(chrono, V) :- printf(trace, "%3d: ", V). write_attribute_Op(call, V) :- write_trace(V), write_trace(' '). write_attribute_Op(depth, V) :- write_trace('['), write_trace(V), write_trace('] '). write_attribute_Op(port, V) :- write_trace(V), write_trace(' '). write_attribute_Op(proc_type, V) :- write_trace('('), write_trace(V), write_trace(') '). write_attribute_Op(decl_module, V) :- write_trace(V), write_trace(': '). write_attribute_Op(def_module, V) :- write_trace('{'), write_trace(V), write_trace('} '). write_attribute_Op(name, V) :- write_trace(V). write_attribute_Op(arity, V) :- write_trace('/'), write_trace(V). write_attribute_Op(mode_number, V) :- write_trace('-'), write_trace(V). write_attribute_Op(deter, V) :- write_trace(V), write_trace(' '). write_attribute_Op(goal_path, V) :- write_trace(' '), write_trace(V), write_trace(' '). write_attribute_Op(line_number, V) :- write_trace(' '), write_trace(V), write_trace(' '). write_attribute_Op(type_arg, Type) :- write_trace(" {"), replace_dotdot_by_underscore_in_term(Type, Type2), write_trace(Type2), write_trace("}"). write_attribute_Op(listvar, List) :- ( List = [] -> true ; write_trace("\nNon-argument live variables:\n"), print_list_var(List) ). % :- pred replace_dotdot_by_underscore_in_term(term, string). % :- mode replace_dotdot_by_underscore_in_term(in, out) is det. replace_dotdot_by_underscore_in_term(Term, NewTerm) :- % if Term = list : list (io : result) % then Newterm = list__list (io__result) ( % ex: Term = int atom(Term), atom_string(Term, NewTerm), ! ; % ex: Term = list : list(int) Term = Module : SubTerm, atom_string(Module, ModuleStr), replace_dotdot_by_underscore_in_term(SubTerm, NewSubTerm), concat_string([ModuleStr, "__", NewSubTerm], NewTerm), ! ; % ex: Term = list(io : result) Term =.. [Functor | ListArg], atom_string(Functor, FunctorStr), replace_dotdot_by_underscore_in_list(ListArg, NewListArgStr), concat_string([FunctorStr, "(", NewListArgStr, ")"], NewTerm), ! ; write_trace("Problem in printing the type") ). %:- pred replace_dotdot_by_underscore_in_list(list(term), string). %:- mode replace_dotdot_by_underscore_in_list(in, out) is det. replace_dotdot_by_underscore_in_list([Arg], String) :- replace_dotdot_by_underscore_in_term(Arg, String). replace_dotdot_by_underscore_in_list([Arg | Tail], String) :- replace_dotdot_by_underscore_in_term(Arg, NewArgStr), replace_dotdot_by_underscore_in_list(Tail, TailStr), concat_string([NewArgStr, " ,", TailStr], String). %:- pred print_list_var(list(T)). %:- mode print_list_var(in) is det. print_list_var([]). print_list_var([live_var(VarName, Value, Type) | Xs]) :- printf(trace,"\t%w = %w {%w}\n", [VarName, Value, Type]), print_list_var(Xs). %------------------------------------------------------------------------------% opium_procedure( name : write_arg_attribute, arg_list : [Procedure, ListArg, ArgFlag, TypeFlag], implementation : write_arg_attribute_Op, parameters : [attribute_display], message : "Displays the arguments of the trace event when the \ current procedure is `Module:Name/Arity-ModeNum'. If only the nth argument \ of a procedure needs a special treatment, you should customize `write_arg/1'.\ " ). %:- pred write_arg_attribute_Op(atom, atom, atom, atom). %:- mode write_arg_attribute_Op(in, in, in, in) is det. write_arg_attribute_Op(_:_/Arity-_, _, _, _) :- Arity == 0, !. write_arg_attribute_Op(Proc, ListArg, ArgFlag, TypeFlag) :- write_trace('('), write_arguments(1, Proc, ListArg, ArgFlag, TypeFlag), write_trace(')'). %:- pred write_arguments(integer, procedure, list(argument), flag, flag). %:- mode write_arguments(in, in, in, in, in) is det. write_arguments(_,_,_, off, off). write_arguments(N, Proc, ListArg, ArgFlag, TypeFlag) :- ( retrieve_live_arg(ListArg, N, Arg, Type) -> true ; % This argument is not currently live. % X Should we display the source arguments here ? Arg = '-' ), ( arguments_display(normal), ArgFlag = on, % write arguments in the normal way write_nth_arg(Arg, N, Proc) ; ArgFlag = on, % write arguments in a simple way writeq_trace(Arg) ; % ArgFlag = off true ), ( not(free(Type)) -> print_line_attribute(type_arg, Type, TypeFlag) ; true ), NN is N + 1, write_tail(NN, Proc, ListArg, ArgFlag, TypeFlag). %:- pred write_tail(integer, procedure, list(argument), flag, flag). %:- mode write_tail(in, in, in, in, in) is det. write_tail(N, DeclModule:Name/Arity-ModeNum, ListArg, ArgFlag, TypeFlag) :- ( (N =< Arity) -> write_comma, write_arguments(N, DeclModule:Name/Arity-ModeNum, ListArg, ArgFlag, TypeFlag) ; true ). %:- pred retrieve_live_arg(list(live_var), int, atom, atom). %:- mode retrieve_live_arg(in, in, out, out) is semidet. % Take a list of live arguments and an integer N and returns the Nth % argument and its type if it is live (i.e. if it is in the list). retrieve_live_arg([live_var(VarName, Instance, Type)|_], N, Instance, Type) :- headvar_to_integer(VarName, N). retrieve_live_arg([_ | Tail], N, Instance, Type) :- retrieve_live_arg(Tail, N, Instance, Type). %------------------------------------------------------------------------------% opium_procedure( name : write_nth_arg, arg_list : [Arg, N, Procedure], %arg_list : [Arg, N, DeclModule:Name/Arity-ModeNum], implementation : write_nth_arg_Op, parameters : [arguments_display, arg_undisplay, term_display, list_display], message : "Displays the nth argument of procedure `Procedure' in `DeclModule'.\ " ). %:- pred write_nth_arg(argument, integer, procedure). %:- mode write_nth_arg(in, in, in) is det. write_nth_arg_Op(Arg, N, DeclModule:Name/Arity-ModeNum) :- ( ( arg_undisplay(DeclModule:Name/Arity-ModeNum, N) ; arg_undisplay(Name/Arity-ModeNum, N) ; arg_undisplay(Name/Arity, N) ) -> /* arg not to be displayed */ write_ersatz ; write_arg(Arg) ). %------------------------------------------------------------------------------% opium_procedure( name : write_arg, arg_list : [Arg], implementation : write_arg_Op, parameters : [term_display, list_display], message : "Prints procedure arguments.\ " ). %:- pred write_arg(argument). %:- mode write_arg(in) is det. write_arg(A) :- write_arg_Op(A). 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). %------------------------------------------------------------------------------% opium_procedure( name : write_term, arg_list : [Term], implementation : write_term_Op, parameters : [term_display], message : "Displays a structured term, taking into account the `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). %:- pred write_term(term). %:- mode write_term(in) is det. 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 */ %:- pred write_term_normal(term, integer, ?, ). %:- mode write_term_normal() is det. 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). % XXX ???: fourth argument of write_term_normal is always '_'. % Mireille wrote that code, I should ask her what she means doing so. 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). %------------------------------------------------------------------------------% opium_procedure( name : write_list, arg_list : [List], implementation : write_list_Op, parameters : [list_display], message : "Displays a list, taking into account the `list_display' parameter.\ " ). %:- pred write_list_Op(list(T)). %:- mode write_list_Op(in) is det. 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). %------------------------------------------------------------------------------% opium_procedure( name : write_ersatz, arg_list : [], implementation : write_ersatz_Op, parameters : [], message : "Writes `...' as a replacement for the hidden parts of the arguments.\ " ). %:- pred write_ersatz is det. write_ersatz_Op :- write_trace('...'). %------------------------------------------------------------------------------% opium_procedure( name : write_comma, arg_list : [], implementation : write_comma_Op, parameters : [], message : "Writes `, '." ). write_comma_Op :- write_trace(', '). %------------------------------------------------------------------------------% opium_procedure( name : write_trace, arg_list : [X], implementation : write_trace_Op, parameters : [], message : 'Prints its argument on the trace window.\ ' ). %:- pred write_trace(atom). %:- mode write_trace(in) is det. write_trace_Op(X) :- write(trace, X), flush(trace). %------------------------------------------------------------------------------% %:- pred writeq_trace(atom). %:- mode writeq_trace(in) is det. writeq_trace(X) :- printf(trace, "%Qw", [X]). %------------------------------------------------------------------------------% opium_parameter( name : attribute_display, arg_list : [Chrono, Call, Port, Depth, Deter, PredOrFunc, DeclModule, DefModule, Name, Arity, ModeNumber, ListArg, ListNonArgVar, Type, GoalPath, LineNumber], 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]), 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 : [on, on, on, on, off, off, off, off, on, off, off, on, off, off, on, on], commands : [print_event], message : "Parameter which contains the flags for the selective display of attributes. \ If the value of one argument is \"on\" then the corresponding attribute is \ displayed.\ " ). %------------------------------------------------------------------------------% opium_parameter( name : arguments_display, arg_list : [Type], arg_type_list : [is_member([normal, simple])], parameter_type : single, default : [normal], commands : [write_arg], message : "Specifies how arguments shall be displayed. If `Type' is set to `simple', \ then arguments are displayed without taking the `list_display' and \ `term_display' parameters into account.\ " ). %------------------------------------------------------------------------------% 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 : "Specifies how lists shall be displayed. If `Type' is set to `normal', \ lists are displayed in the standard Prolog way. If `Type' is set to `nest', \ the nested lists are displayed only till level `Range' (included). If `Type' is \ set to `truncate', only the first `Range' elements of the lists are displayed.\ " ). %------------------------------------------------------------------------------% 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 : "Specifies how structured terms shall be displayed. If `Type' is set to \ `normal', terms are displayed in the standard Prolog way. If `Type' is \ set to `nest', the nested terms are displayed only till level `Range' \ (included). If `Type' is set to `truncate', only the first `Range' elements \ of the term are displayed.\ " ). %------------------------------------------------------------------------------% opium_parameter( name : indent_display, arg_list : [OnOff, IndentationValue, Depth], arg_type_list : [is_member([on, off]), atomic, integer], parameter_type : single, default : [on, ' ', 1], commands : [print_event, write_indent], message : "Specifies whether indentation is `on' or `off', what has to be \ printed as indentation value, and at which depth the indentation has to be \ started.\ " ). %------------------------------------------------------------------------------% opium_parameter( name : indent_display_limit, arg_list : [IndentLimit], arg_type_list : [integer], parameter_type : single, default : [30], commands : [write_indent], message : "Specifies up to which depth the trace events shall be indented.\ " ). %------------------------------------------------------------------------------% opium_parameter( name : arg_undisplay, arg_list : [Name, ArgNo], arg_type_list : [is_proc, integer], parameter_type : multiple, default : nodefault, commands : [write_arg], message : "Specifies which arguments of which predicates have to be not \ displayed. There must be one `arg_undisplay' clause for each argument which \ 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) :- !. %------------------------------------------------------------------------------% opium_procedure( name : read_input, arg_list : [Input], implementation : read_input_Op, parameters : [], message : "Reads an input from within the current input stream of Morphine.\ " ). /* read in both cases from the input stream */ read_input_Op(X) :- read(input, X). %------------------------------------------------------------------------------% opium_command( name : toggle, arg_list : [AttributeName], arg_type_list : [atom], abbrev : _, interface : hidden, command_type : opium, implementation : toggle_Op, parameters : [], message : "Toggles attribute display of `print_event/1' command. \n\ For example, if attribute `decl_module' is off, you can type \ `toggle(decl_module)' to switch it on. You can list all the attributes \ you can toggle thanks to `list_attribute_aliases/0'.\ " ). toggle_Op(Keyword) :- get_parameter(attribute_display, ListDisplay), !, update_list_display(Keyword, ListDisplay, NewListDisplay), set_parameter(attribute_display, NewListDisplay). update_list_display(Keyword, ListDisplay, NewListDisplay) :- ( is_alias_for(chrono, Keyword), ListDisplay = [S, O2,O3,O4,O5,O6,O7,O8,O9,O10,O11,O12,O13, O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [NewS, O2,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(call, Keyword), ListDisplay = [O1, S,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1, NewS,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(port, Keyword), ListDisplay = [O1,O2, S,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2, NewS,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13, O14,O15,O16], ! ; is_alias_for(depth, Keyword), ListDisplay = [O1,O2,O3, S,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3, NewS,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(det, Keyword), ListDisplay = [O1,O2,O3,O4,S,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,NewS,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(proc_type, Keyword), ListDisplay = [O1,O2,O3,O4,O5,S,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,NewS,O7,O8,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(decl_module, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,S,O8,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,NewS,O8,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(def_module, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,S,O9,O10,O11, O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,NewS,O9,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(name, Keyword), ListDisplay = [O1,O2,O3,O,O5,O6,O7,O8,S,O10,O11,O12, O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O,O5,O6,O7,O8,NewS,O10,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(arity, Keyword), ListDisplay = [O1,O2,O3,O,O5,O6,O7,O8,O9,S,O11,O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O,O5,O6,O7,O8,O9,NewS,O11, O12,O13,O14,O15,O16], ! ; is_alias_for(mode_number, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,S,O12,O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,NewS, O12,O13,O14,O15,O16], ! ; is_alias_for(args, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11,S, O13,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10, O11,NewS,O13,O14,O15,O16], ! ; is_alias_for(local_vars, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,S,O14,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,NewS,O14,O15,O16], ! ; is_alias_for(arg_types, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11,O12, O13,S,O15,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,NewS,O15,O16], ! ; is_alias_for(goal_path, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11,O12, O13,O14,S,O16], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,NewS,O16], ! ; is_alias_for(line_number, Keyword), ListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11,O12, O13,O14,O15,S], ( S = off -> NewS = on ; NewS = off ), NewListDisplay = [O1,O2,O3,O4,O5,O6,O7,O8,O9,O10,O11, O12,O13,O14,O15,NewS] ). %------------------------------------------------------------------------------% opium_procedure( name : display_stack, arg_list : [Stack], implementation : display_stack_Op, parameters : [], message : "Displays the ancestors stack." ). display_stack_Op([level(Level) | Tail]) :- printf(trace, "\nLevel %w: ", Level), display_stack_Op(Tail). display_stack_Op([detail(Chrono, Call, Depth) | Tail]) :- printf(trace, "(chrono=%w, call=%w, depth=%w) ", [Chrono, Call, Depth]), display_stack_Op(Tail). display_stack_Op([pred | Tail]) :- printf(trace, "pred ", []), display_stack_Op(Tail). display_stack_Op([func | Tail]) :- printf(trace, "func ", []), display_stack_Op(Tail). display_stack_Op([proc(Proc) | Tail]) :- printf(trace, "%w ", Proc), display_stack_Op(Tail). display_stack_Op([proc(M1,M2,N,A,MN) | Tail]) :- printf(trace, "%w for w:%w/%w-%w ", [M1,M2,N,A,MN]), display_stack_Op(Tail). display_stack_Op([proc(M,N,A,MN) | Tail]) :- printf(trace, "%w:%w/%w-%w ", [M,N,A,MN]), display_stack_Op(Tail). display_stack_Op([det(Det) | Tail]) :- printf(trace, "(%w) ", Det), display_stack_Op(Tail). display_stack_Op([def_module(Module) | Tail]) :- printf(trace, "{definition module=%w} ", Module), display_stack_Op(Tail). display_stack_Op([]) :- printf(trace, "\n", []), flush(trace). %------------------------------------------------------------------------------% opium_procedure( name : display_list_var_names, arg_list : [ListVarNames], implementation : display_list_var_names_Op, parameters : [], message : "Displays the names of the currently live variables given by \ `current_live_var_names_and_types/1'.\ " ). display_list_var_names_Op([]). display_list_var_names_Op([ live_var_names_and_types(Name, Type) | Tail]) :- printf(user, " %w {%w}\n", [Name, Type]), display_list_var_names_Op(Tail).