mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-20 03:43:51 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/extras/morphine/source/event_attributes.op
Erwan Jahier 860dd288aa Add line numbers in Morphine. 
Estimated hours taken: 3
Branch: main


Add line numbers in Morphine.

trace/mercury_trace_external.c
	Modify MR_output_current_slots() so that it takes a MR_Event_Info *
	rather than a MR_Label_Layout *. The reason is that I need it to
	get the parent of the current event. I need the parent of the current
	goal because I want the line number where the call is made,
	not the one where the procedure is defined.

	Add the line number as an output of ML_DI_output_current_slots_*.


browser/util.m
	Define the line_number type.

browser/debugger_interface.m
	Add the line number as argument of output_current_slots/13.


extras/morphine/source/current_slots.op
	Add the line number as argument of current_attributes/12.

extras/morphine/source/display.op
	Add the line number as argument of attribute_display/12 and
	of the attribute_display parameter.

extras/morphine/source/event_attributes.op
	Define the new event attribute alias.

extras/morphine/non-regression-tests/test_vars.exp:
extras/morphine/non-regression-tests/queens.exp:
	Update the expected output of the non-regression test.

extras/morphine/non-regression-tests/queens.in:
	Disable the testing of the browser as it is currently broken.
2001-06-22 15:20:28 +00:00

684 lines
17 KiB
Plaintext
Raw Blame History

%------------------------------------------------------------------------------%
% 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>
%
% This files contains various types declarations concerning the event
% attributes. Those types are used both in forward_move.op and
% current_slots.op.
%------------------------------------------------------------------------------%
opium_type(
name : is_port,
implementation : is_port_Op,
message :
"Succeeds for a Mercury Port. Mercury ports are call (or 'CALL'), \
exit (or 'EXIT'), fail (or 'FAIL'), redo (or 'REDO'), then (or 'THEN'), \
else (or 'ELSE'), disj (or 'DISJ'), switch (or 'SWITCH' or 'SWTC'), \
first (or 'FIRST' or 'FRST'), later (or 'LATER' or 'LATR'), \
exception (or 'EXCP' or 'EXCEPTION'). \
").
is_port_Op(Port) :-
is_list_of_ports_Op([Port]).
%------------------------------------------------------------------------------%
opium_type(
name : is_port_or_var,
implementation : is_port_or_var_Op,
message :
"Succeeds for a Mercury port or a variable (See `is_port/1').\
").
is_port_or_var_Op(X) :-
var(X), !
;
is_port(X).
%------------------------------------------------------------------------------%
opium_type(
name : is_list_of_ports,
implementation : is_list_of_ports_Op,
message :
"Succeeds for a sublist of ['CALL', 'EXIT', 'REDO', 'FAIL', 'THEN',\
'ELSE', 'DISJ', 'SWITCH', 'SWTC', 'FIRST', 'FRST', 'LATER', 'LATR', 'EXCP', \
'EXCEPTION', \
call, exit, fail, redo, cond, then, else, disj, switch, first, later, exception, \
neg_enter, neg_success, neg_failure].\
").
is_list_of_ports_Op(List) :-
list_of_mercury_ports(ListMercPorts),
is_sublist(List, ListMercPorts).
is_sublist([], _).
is_sublist([Term | Tail], L2) :-
member(Term, L2),
is_sublist(Tail, L2).
list_of_mercury_ports([
'CALL', 'EXIT', 'FAIL', 'REDO', 'THEN', 'ELSE', 'DISJ', 'SWITCH',
'SWTC', 'FIRST', 'FRST', 'LATER', 'LATR', 'EXCP', 'EXCEPTION',
call, exit, fail, redo, cond, then, else, disj, switch, first, later,
exception, neg_enter, neg_success, neg_failure]).
%------------------------------------------------------------------------------%
opium_type(
name : is_port_attribute,
implementation : is_port_attribute_Op,
message :
"Succeeds for a port, a negated port (not('CALL')), a list of \
ports, '-' or a variable.\
").
is_port_attribute_Op(Attribute) :-
Attribute == '-'
;
free(Attribute), !
;
is_port(Attribute)
;
Attribute = not(AttributeNeg),
is_port(AttributeNeg)
;
Attribute = \+(AttributeNeg),
is_port(AttributeNeg)
;
is_list_of_ports(Attribute)
.
%------------------------------------------------------------------------------%
opium_type(
name : is_goal_path,
implementation : is_goal_path_Op,
message :
"Succeeds for list of atoms of the form '?','e', 't', '~', 'q', \
'ci', 'si', 'di' where i is an integer > 0."
).
is_goal_path_Op([X|Xs]) :-
is_valid_path(X),
is_goal_path_Op(Xs).
is_goal_path_Op([]).
is_valid_path('?').
is_valid_path(e).
is_valid_path(t).
is_valid_path(q).
is_valid_path('~').
is_valid_path(X) :-
atom_string(X, Xstr),
append_strings("d", IntStr, Xstr),
atom_string(Int, IntStr),
integer_atom(_, Int).
is_valid_path(X) :-
atom_string(X, Xstr),
append_strings("c", IntStr, Xstr),
atom_string(Int, IntStr),
integer_atom(_, Int).
is_valid_path(X) :-
atom_string(X, Xstr),
append_strings("s", IntStr, Xstr),
atom_string(Int, IntStr),
integer_atom(_, Int).
%------------------------------------------------------------------------------%
opium_type(
name : is_goal_path_or_var,
implementation : is_goal_path_or_var_Op,
message :
"Succeeds for a Mercury goal path or a variable (See `is_goal_path/1').").
is_goal_path_or_var_Op(X) :-
var(X), !
;
is_goal_path(X).
%------------------------------------------------------------------------------%
% Should we need a Opium declaration for this one ?
% :- pred is_list_of_paths(attribute).
% :- mode is_list_of_paths(in) is semidet.
is_list_of_goal_paths([X|Xs]) :-
is_goal_path(X),
is_list_of_goal_paths(Xs).
is_list_of_goal_paths([]).
%------------------------------------------------------------------------------%
opium_type(
name : is_goal_path_attribute,
implementation : is_goal_path_attribute_Op,
message :
"Succeeds for a goal path, a negated goal path, a list of goal path, '-' or \
a variable.").
is_goal_path_attribute_Op(Attribute) :-
Attribute == '-'
;
free(Attribute), !
;
is_goal_path(Attribute)
;
Attribute = not(AttributeNeg),
is_goal_path(AttributeNeg)
;
Attribute = \+(AttributeNeg),
is_goal_path(AttributeNeg)
;
is_list_of_goal_paths(Attribute)
.
%------------------------------------------------------------------------------%
opium_type(
name : is_atom_attribute,
implementation : is_atom_attribute_Op,
message :
"Succeeds for an atom, a negated atoms, a list of atom, a variable \
or '-'. It is intended to check `proc_name' `def_module' and \
`decl_module' attributes.\
").
is_atom_attribute_Op(Attribute) :-
Attribute == '-'
;
free(Attribute), !
;
atom(Attribute), !
;
Attribute = not(AttributeNeg),
atom(AttributeNeg), !
;
Attribute = \+(AttributeNeg),
atom(AttributeNeg), !
;
is_list_of_atoms(Attribute)
.
%------------------------------------------------------------------------------%
opium_type(
name : is_proc_type,
implementation : is_proc_type_Op,
message :
"Succeeds for the atoms `predicate' and `function'.").
is_proc_type_Op(X) :-
member(X, [predicate, function]).
%------------------------------------------------------------------------------%
opium_type(
name : is_proc_type_attribute,
implementation : is_proc_type_attribute_Op,
message :
"Succeeds for pred or func, not(pred) or not(func), \
a list of atoms pred or func, '-' or a variable.").
is_proc_type_attribute_Op(Attribute) :-
Attribute == '-'
;
free(Attribute), !
;
member(Attribute, [predicate, function]), !
;
Attribute = not(AttributeNeg),
member(AttributeNeg, [predicate, function]), !
;
Attribute = \+(AttributeNeg),
member(Attribute, [predicate, function]), !
;
subtract(Attribute, [predicate, function], [])
.
%------------------------------------------------------------------------------%
opium_type(
name : is_det_marker,
implementation : is_det_marker_Op,
message :
"Succeeds for a Mercury determinism marker. Mercury determinism are \
det (or 'DET'), semidet (or 'SEMI'), nondet (or 'NON'), multidet (or 'MUL'), \
cc_nondet (or 'CCNON'), cc_multidet (or 'CCMUL'), failure (or 'FAIL') and \
erroneous (or 'ERR'). \
").
is_det_marker_Op(Det) :-
is_list_of_dets_Op([Det]).
%------------------------------------------------------------------------------%
opium_type(
name : is_det_marker_or_var,
implementation : is_det_marker_or_var_Op,
message :
"Succeeds for a Mercury determinism markers or a variable.\
").
is_det_marker_or_var_Op(X) :-
var(X), !
;
is_det_marker(X).
%------------------------------------------------------------------------------%
opium_type(
name : is_list_of_dets,
implementation : is_list_of_dets_Op,
message :
"Succeeds for a sublist of [det, semidet, nondet, multidet,\
cc_nondet, cc_multidet, failure, erroneous, 'DET', 'SEMI', 'NON', 'MUL', \
'ERR', 'FAIL', 'CCNON', 'CCMUL'] \
(the determinism markers in capital letters are the ones used in mdb, the \
internal Mercury debugger).\
").
is_list_of_dets_Op(List) :-
list_of_mercury_dets(ListMercDets),
is_sublist(List, ListMercDets).
list_of_mercury_dets([det, semidet, nondet, multidet, cc_nondet,
cc_multidet, failure, erroneous, 'DET', 'SEMI', 'NON', 'MUL',
'ERR', 'FAIL', 'CCNON', 'CCMUL']).
%------------------------------------------------------------------------------%
opium_type(
name : is_det_marker_attribute,
implementation : is_det_marker_attribute_Op,
message :
"Succeeds for a Mercury determinism marker, a negated determinism \
(not(nondet)), a list of determinism markers, '-' or a variable.\
").
is_det_marker_attribute_Op(Attribute) :-
Attribute == '-'
;
free(Attribute), !
;
is_det_marker(Attribute), !
;
Attribute = not(AttributeNeg),
is_det_marker(AttributeNeg), !
;
Attribute = \+(AttributeNeg),
is_det_marker(AttributeNeg), !
;
is_list_of_dets(Attribute)
.
%------------------------------------------------------------------------------%
opium_type(
name : is_proc,
implementation : is_proc_Op,
message :
"Succeeds for terms of the form \
`[ProcType+][Module:]ProcName[/Arity][-ModeNum]' where terms betwenn square \
bracquets are optional, `ProcType' has type `is_proc_type_attribute/1', \
`Module' and `ProcName' have type `is_atom_attribute/1', `Arity' and `ModeNum' \
have `type is_integer_attribute/1'.").
is_proc_Op(Proc) :-
(
Proc = P,
is_atom_attribute(P),
!
;
Proc = (PT->P),
is_proc_type_attribute(PT),
is_atom_attribute(P),
!
;
Proc = M:P,
is_atom_attribute(M),
is_atom_attribute(P),
!
;
Proc = P/A,
is_atom_attribute(P),
is_integer_attribute(A),
!
;
Proc = P-MN,
is_atom_attribute(P),
is_integer_attribute(MN),
!
;
Proc = (P/A-MN),
is_atom_attribute(P),
is_integer_attribute(A),
is_integer_attribute(MN),
!
;
Proc = M:(P-MN),
is_atom_attribute(M),
is_atom_attribute(P),
is_integer_attribute(MN),
!
;
Proc = M:(P/A),
is_atom_attribute(M),
is_atom_attribute(P),
is_integer_attribute(A),
!
;
Proc = (PT->(P-MN)),
is_proc_type_attribute(PT),
is_atom_attribute(P),
is_integer_attribute(MN),
!
;
Proc = (PT->(P/A)),
is_proc_type_attribute(PT),
is_atom_attribute(P),
is_integer_attribute(A),
!
;
Proc = (PT->M:P),
is_proc_type_attribute(PT),
is_atom_attribute(M),
is_atom_attribute(P),
!
;
Proc = M:(P/A-MN),
is_atom_attribute(M),
is_atom_attribute(P),
is_integer_attribute(A),
is_integer_attribute(MN),
!
;
Proc = (PT->(P/A-MN)),
is_proc_type_attribute(PT),
is_atom_attribute(P),
is_integer_attribute(A),
is_integer_attribute(MN),
!
;
Proc = (PT->M:(P-MN)),
is_proc_type_attribute(PT),
is_atom_attribute(M),
is_atom_attribute(P),
is_integer_attribute(MN),
!
;
Proc = (PT->M:(P/A)),
is_proc_type_attribute(PT),
is_atom_attribute(M),
is_atom_attribute(P),
is_integer_attribute(A),
!
;
Proc = (PT->M:(P/A-MN)),
is_proc_type_attribute(PT),
is_atom_attribute(M),
is_atom_attribute(P),
is_integer_attribute(A),
is_integer_attribute(MN)
).
is_proc_Op(-) :-
!.
%------------------------------------------------------------------------------%
opium_type(
name : is_proc_or_var,
implementation : is_proc_or_var_Op,
message :
"Succeeds for a Mercury procedure or a variable.\
").
is_proc_or_var_Op(X) :-
var(X), !
;
is_proc(X).
%------------------------------------------------------------------------------%
opium_type(
name : is_arg_attribute,
implementation : is_arg_attribute_Op,
message :
"For the time being, you can't perform filtering on arguments, i.e., you can \
only have variables or '-' for that attribute.\
").
is_arg_attribute_Op(Attribute) :-
free(Attribute) ; Attribute == '-'.
%------------------------------------------------------------------------------%
opium_type(
name : is_integer_attribute,
implementation : is_integer_attribute_Op,
message :
"Succeeds for an integer, a negated integer (not 6), a list of \
integers ([3, 5, 9]), an interval ('3..11'), a variable or '-'.\
"
).
is_integer_attribute_Op(Attribute) :-
Attribute == '-',
!
;
free(Attribute),
!
;
integer(Attribute),
!
;
Attribute = not(AttributeNeg),
integer(AttributeNeg),
!
;
Attribute = \+(AttributeNeg),
integer(AttributeNeg),
!
;
is_list_of_integers(Attribute),
!
;
Attribute = Bottom .. Up,
integer(Bottom),
integer(Up),
Bottom =< Up
.
%:- pred is_list_of_integers(list(integer)).
%:- mode is_list_of_integers(in) is semidet.
is_list_of_integers([]).
is_list_of_integers([X | Xs]) :-
integer(X),
is_list_of_integers(Xs).
%------------------------------------------------------------------------------%
opium_type(
name : is_string_attribute,
implementation : is_string_attribute_Op,
message :
"Succeeds for a string, a negated string (not \"foo\"), a list of \
strings, a variable or '-'.\
").
is_string_attribute_Op(Attribute) :-
Attribute == '-'
;
free(Attribute), !
;
string(Attribute)
;
Attribute = not(AttributeNeg),
string(AttributeNeg)
;
Attribute = \+(AttributeNeg),
string(AttributeNeg)
;
is_list_of_strings(Attribute)
.
%:- pred is_list_of_strings(list(string)).
%:- mode is_list_of_strings(in) is semidet.
is_list_of_strings([]).
is_list_of_strings([X | Xs]) :-
string(X),
is_list_of_strings(Xs).
%------------------------------------------------------------------------------%
opium_command(
name : list_attribute_aliases,
arg_list : [],
arg_type_list : [],
abbrev : laa,
interface : hidden,
command_type : opium,
implementation : list_attribute_aliases_op,
parameters : [],
message :
"Lists the available aliases for the different Mercury event attributes \
(`fget/1' and `current/1').").
list_attribute_aliases_op :-
findall(X, is_alias_for(chrono, X), Lchrono),
findall(X, is_alias_for(call, X), Lcall),
findall(X, is_alias_for(depth, X), Ldepth),
findall(X, is_alias_for(port, X), Lport),
findall(X, is_alias_for(proc_type, X), LPredOrFunc),
findall(X, is_alias_for(decl_module, X), Ldeclmodule),
findall(X, is_alias_for(def_module, X), Ldefmodule),
findall(X, is_alias_for(name, X), Lname),
findall(X, is_alias_for(arity, X), Larity),
findall(X, is_alias_for(mode_number, X), Lmode_number),
findall(X, is_alias_for(proc, X), Lproc),
findall(X, is_alias_for(det, X), Ldet),
findall(X, is_alias_for(goal_path, X), Lgoal_path),
findall(X, is_alias_for(args, X), Largs),
findall(X, is_alias_for(arg_names, X), LArgsName),
findall(X, is_alias_for(arg_types, X), LArgsType),
findall(X, is_alias_for(vars, X), LVars),
findall(X, is_alias_for(var_names_and_types, X), Lvar_names_and_types),
findall(X, is_alias_for(local_vars, X), Lother),
findall(X, is_alias_for(stack, X), Lstack),
printf("List of attribute aliases for fget/1 and current/1:\n",[]),
printf("%19s: %w\n", [chrono, Lchrono]),
printf("%19s: %w\n", [call, Lcall]),
printf("%19s: %w\n", [depth, Ldepth]),
printf("%19s: %w\n", [port, Lport]),
printf("%19s: %w\n", [proc_type, LPredOrFunc]),
printf("%19s: %w\n", [def_module, Ldefmodule]),
printf("%19s: %w\n", [decl_module, Ldeclmodule]),
printf("%19s: %w\n", [name, Lname]),
printf("%19s: %w\n", [arity, Larity]),
printf("%19s: %w\n", [mode_number, Lmode_number]),
printf("%19s: %w\n", [proc, Lproc]),
printf("%19s: %w\n", [det, Ldet]),
printf("%19s: %w\n", [goal_path, Lgoal_path]),
printf("\nList of attribute aliases for current/1 only:\n",[]),
printf("%19s: %w\n", [args, Largs]),
printf("%19s: %w\n", [arg_names, LArgsName]),
printf("%19s: %w\n", [arg_types, LArgsType]),
printf("%19s: %w\n", [vars, LVars]),
printf("%19s: %w\n", [var_names_and_types, Lvar_names_and_types]),
printf("%19s: %w\n", [local_vars, Lother]),
printf("%19s: %w\n", [stack, Lstack]).
%------------------------------------------------------------------------------%
% opium_primitive(
% name : is_alias_for,
% arg_list : [AttributeName, Alias],
% arg_type_list : [atom, atom],
% implementation : is_alias_for_Op,
% message :
% "Succeeds if Alias is an alias for the attribute AttributeName. The aliases \
% for all the attributes can be listed with list_attribute_aliases/0 command.
% "
% ).
% This is used for both fget/1 and current/1 command.
is_alias_for(chrono, chrono).
is_alias_for(chrono, c).
is_alias_for(call, call).
is_alias_for(call, ca).
is_alias_for(call, cl).
is_alias_for(depth, depth).
is_alias_for(depth, d).
is_alias_for(port, port).
is_alias_for(port, p).
is_alias_for(proc, procedure).
is_alias_for(proc, proc).
is_alias_for(name, procedure_name).
is_alias_for(name, proc_name).
is_alias_for(name, name).
is_alias_for(name, n).
is_alias_for(proc_type, proc_type).
is_alias_for(proc_type, pred_or_func).
is_alias_for(proc_type, pof).
is_alias_for(decl_module, decl_module).
is_alias_for(decl_module, decl_mod).
is_alias_for(decl_module, dlm).
is_alias_for(def_module, def_module).
is_alias_for(def_module, def_mod).
is_alias_for(def_module, dfm).
is_alias_for(arity, arity).
is_alias_for(arity, ar).
is_alias_for(mode_number, mode_number).
is_alias_for(mode_number, mode_num).
is_alias_for(mode_number, mn).
is_alias_for(det, determinism).
is_alias_for(det, deter).
is_alias_for(det, det).
is_alias_for(goal_path, goal_path).
is_alias_for(goal_path, gp).
is_alias_for(line_number, line_number).
is_alias_for(line_number, ln).
% XXX Those ones are not hanled in fget yet.
is_alias_for(args, arguments).
is_alias_for(args, args).
is_alias_for(args, arg).
is_alias_for(args, a).
is_alias_for(arg_names, arg_names).
is_alias_for(arg_names, an).
is_alias_for(arg_types, arg_types).
is_alias_for(arg_types, types).
is_alias_for(arg_types, type).
is_alias_for(arg_types, at).
is_alias_for(vars, vars).
is_alias_for(var_names_and_types, var_names_and_types).
is_alias_for(var_names_and_types, vnt).
is_alias_for(local_vars, local_vars).
is_alias_for(local_vars, local_var).
is_alias_for(local_vars, non_arg_vars).
is_alias_for(local_vars, other_live_var).
is_alias_for(local_vars, nav).
is_alias_for(stack, stack).
is_alias_for(stack, stk).
is_alias_for(stack, s).
Reference in New Issue View Git Blame Copy Permalink