mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-19 11:23:46 +00:00
Estimated hours taken: .2 branches: main. extras/morphine/source/display.op Fix a cut and paste error when I added line numbers in the morphine trace.
1598 lines
40 KiB
Plaintext
1598 lines
40 KiB
Plaintext
%------------------------------------------------------------------------------%
|
|
% 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 <jahier@irisa.fr>
|
|
%
|
|
|
|
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).
|
|
|