[m-rev.] for review: user-defined events
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Nov 20 16:36:57 AEDT 2006
For review by Mark.
Zoltan.
The objective of this diff is to switch from a table of solver events built
into the compiler (and eventually the debugger) into a table of events
defined by a file provided by the user to the compiler, which the compiler
then records in the executable for use by the debugger.
The current design, for speed of implementation, uses temporary files parsed
by a bison-generated parser. Since the compiler needs to be able to invoke
the parser even if it is compiled in a non-debug grade, the parser is in
a new library, the eventspec library, that is always linked into the Mercury
compiler and is always linked into any Mercury program with debugging enabled
(but is of course linked only once into a Mercury compiler which has debugging
enabled).
Modify the debugger to give it the ability to print the attributes of
user-defined events (for now, only the non-synthesized attributes).
Implement a new debugger command, "user", which goes to the next user-defined
event.
doc/user_guide.texi:
Document user defined events and the new debugger capabilities.
doc/mdb_categories:
Include "user" in the list of forward movement commands.
Fix some earlier omissions in that list.
runtime/mercury_stack_layout.h:
Include an event number in the user-defined event structure.
Include a string representing an event set specification in module
layout structures.
runtime/mercury_stack_layout.h:
runtime/mercury_trace_base.[ch]:
runtime/mercury_types.h
Switch from solver events to user events in names.
runtime/mercury_trace_term.[ch]:
Provide a representation of flat terms, for use in representing
the calls that generate synthesized attributes.
Ensure that exported field names have an MR_ prefix.
browser/cterm.m:
Conform to the change to runtime/mercury_trace_term.h.
scripts/c2init.in:
scripts/ml.in:
Include the eventspec library in programs compiled with debugging
enabled.
compiler/Mmakefile:
Include the eventspec library in the compiler.
compiler/options.m:
Add a new option, --event-spec-file-name, that allows the user to
specify the set of user-defined events the program may use.
compiler/handle_options.m:
Set this optimization from an environment variable (which may be
set by the mmc script) if the new option is not explicitly given.
compiler/prog_data.m:
Define the data structures for the compiler's representation of the
event set specification.
Move some definitions around to group them more logically.
compiler/hlds_module.m:
Include the event set specification as a new field in the module_info.
compiler/prog_event.m:
Add the code for invoking the parser in the eventspec library,
and for converting the simple term output by the parser to the
compiler own representation, which contains more information
(to wit, the types of the function attributes) and which has had
a whole bunch of semantic checks done on it (e.g. whether synthesized
attributes depend on themselves or on nonexistent attributes).
Provide a function to generate a canonicalized version of the event
specification file.
compiler/module_qual.m:
compiler/equiv_type.m:
Process event spec specifications as well as items, to module qualify
the names of the types of event arguments, and expanding out
equivalence types.
In equiv_type.m, rename some variables to make clear what kind of info
they represent.
compiler/mercury_compile.m:
Process the event set specification file if one has been selected:
read it in, module qualify it, expand its equivalence types, and add
to the module_info.
compiler/compile_target_code.m:
Include the event_spec library when linking debuggable executables.
compiler/call_gen.m:
compiler/continuation_info.m:
compiler/trace_gen.m:
compiler/trace_params.m:
mdbcomp/prim_data.m:
mdbcomp/trace_counts.m:
runtime/mercury_goto.h:
Generate user-defined events instead of solver events.
compiler/layout.m:
compiler/layout_out.m:
compiler/stack_layout.m:
Include a canonicalized version of the event specification file
in the module layout if the module has any user-defined events.
compiler/code_info.m:
compiler/llds_out.m:
compiler/modes.m:
compiler/modules.m:
compiler/opt_debug.m:
compiler/typecheck.m:
Conform to the changes above.
compiler/passes_aux.m:
Rename a predicate to avoid an ambiguity.
trace/Mmakefile:
Add the definition and rules required to build the eventspec library.
trace/mercury_event_scanner.l:
trace/mercury_event_parser.y:
A scanner and a parser for reading in event spec specifications.
trace/mercury_event_spec_missing.h:
Provide the declarations that should be (but aren't) provided by
flex and bison.
trace/mercury_event_spec.[ch]:
The main module of the eventspec library. Provides functions to read
in event set specifications from a file, and to write them out as a
Mercury term in the form needed by the compiler.
trace/mercury_trace_tables.c:
If the module layouts being registered include event set
specifications, then check their consistency. Make the specification
and the consistency indication available to other modules.
trace/mercury_trace_internal.c:
During initialization, if the modules contain a consistent set of event
set specifications, then read that specification into the debugger.
(We don't yet make use of this information.)
Add an extra mdb command, "user", which goes forward to the next
user-defined event.
trace/mercury_trace.[ch]:
trace/mercury_trace_cmd_forward.[ch]:
Implement the new mdb command.
trace/mercury_trace_vars.[ch]:
For user-defined events, include the attributes' values among the
values that can be printed or browsed.
trace/mercury_trace_cmd_browsing.c:
trace/mercury_trace_declarative.c:
Minor changes.
scripts/scripts/prepare_tmp_dir_grade_part:
Copy the .y and .l files to the tmp dir we use for installs.
tools/bootcheck:
Copy the .y and .l files of the trace directory to stage 2.
tools/lmc.in:
Include the eventspec library when linking debuggable executables.
tests/debugger/user_event.{m,inp,exp}:
tests/debugger/user_event_spec:
New test case to test the new functionality.
tests/debugger/Mercury.options:
tests/debugger/Mmakefile:
Enable the new test case.
tests/debugger/completion.exp:
Expect the new "user" mdb command in the completion output.
cvs diff: Diffing .
Index: Mmake.workspace
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/Mmake.workspace,v
retrieving revision 1.25
diff -u -b -r1.25 Mmake.workspace
--- Mmake.workspace 1 Nov 2006 02:30:59 -0000 1.25
+++ Mmake.workspace 12 Nov 2006 08:20:15 -0000
@@ -80,6 +80,7 @@
RT_LIB_NAME = mer_rt
STD_LIB_NAME = mer_std
TRACE_LIB_NAME = mer_trace
+EVENTSPEC_LIB_NAME = mer_eventspec
BROWSER_LIB_NAME = mer_browser
MDBCOMP_LIB_NAME = mer_mdbcomp
ANALYSIS_LIB_NAME = mer_analysis
@@ -188,6 +189,7 @@
STATIC_STD_LIBS = $(LIBRARY_DIR)/lib$(STD_LIB_NAME).$A
ifneq ($(LINK_STDLIB_ONLY),yes)
STATIC_TRACE_LIBS = $(TRACE_DIR)/lib$(TRACE_LIB_NAME).$A \
+ $(TRACE_DIR)/lib$(EVENTSPEC_LIB_NAME).$A \
$(BROWSER_DIR)/lib$(BROWSER_LIB_NAME).$A \
$(MDBCOMP_DIR)/lib$(MDBCOMP_LIB_NAME).$A
endif
@@ -208,8 +210,8 @@
ifneq ($(LINK_RUNTIME_ONLY),yes)
LINK_STD_LIB_OPTS = -l$(STD_LIB_NAME)
ifneq ($(LINK_STDLIB_ONLY),yes)
-LINK_TRACE_LIB_OPTS = -l$(TRACE_LIB_NAME) -l$(BROWSER_LIB_NAME) \
- -l$(MDBCOMP_LIB_NAME)
+LINK_TRACE_LIB_OPTS = -l$(TRACE_LIB_NAME) -l$(EVENTSPEC_LIB_NAME) \
+ -l$(BROWSER_LIB_NAME) -l$(MDBCOMP_LIB_NAME)
endif
endif
endif
Index: Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/Mmakefile,v
retrieving revision 1.116
diff -u -b -r1.116 Mmakefile
--- Mmakefile 23 Oct 2006 05:15:57 -0000 1.116
+++ Mmakefile 12 Nov 2006 08:18:33 -0000
@@ -59,6 +59,7 @@
RT_LIB_NAME = mer_rt
STD_LIB_NAME = mer_std
TRACE_LIB_NAME = mer_trace
+EVENTSPEC_LIB_NAME = mer_eventspec
MDBCOMP_LIB_NAME = mer_mdbcomp
BROWSER_LIB_NAME = mer_browser
ANALYSIS_LIB_NAME = mer_analysis
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
Index: browser/cterm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/cterm.m,v
retrieving revision 1.5
diff -u -b -r1.5 cterm.m
--- browser/cterm.m 31 Aug 2006 11:09:47 -0000 1.5
+++ browser/cterm.m 10 Nov 2006 05:27:25 -0000
@@ -115,8 +115,8 @@
MR_fatal_error(""cterm_deconstruct: NULL term"");
}
- Functor = Term->term_functor;
- Args = Term->term_args;
+ Functor = Term->MR_term_functor;
+ Args = Term->MR_term_args;
").
:- pragma foreign_proc(c,
@@ -126,8 +126,8 @@
if (Args == NULL) {
SUCCESS_INDICATOR = MR_FALSE;
} else {
- Head = Args->args_head;
- Tail = Args->args_tail;
+ Head = Args->MR_args_head;
+ Tail = Args->MR_args_tail;
SUCCESS_INDICATOR = MR_TRUE;
}
").
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: [05:15:28] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/compiler
cvs diff: [05:15:58] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/compiler
cvs diff: [05:16:28] obtained lock in /home/mercury/mercury1/repository/mercury/compiler
Index: compiler/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mmakefile,v
retrieving revision 1.90
diff -u -b -r1.90 Mmakefile
--- compiler/Mmakefile 24 May 2006 03:36:00 -0000 1.90
+++ compiler/Mmakefile 12 Nov 2006 09:40:42 -0000
@@ -53,7 +53,8 @@
cd $(GCC_SRC_DIR)/gcc && $(MAKE) mercury_gcc_backend_libs
MCFLAGS += --flags COMP_FLAGS $(CONFIG_OVERRIDE)
-MLOBJS := ../main.$O ../analysis/lib$(ANALYSIS_LIB_NAME).$A $(MLOBJS)
+MLOBJS := ../main.$O ../analysis/lib$(ANALYSIS_LIB_NAME).$A \
+ ../trace/lib$(EVENTSPEC_LIB_NAME).$A $(MLOBJS)
ALL_MLLIBS = $(MLLIBS) $(EXTRA_MLLIBS) $(GCC_BACKEND_LIBS)
MLFLAGS += --no-main --shared
C2INITARGS += $(ANALYSIS_DIR)/$(ANALYSIS_LIB_NAME).init
@@ -237,6 +238,7 @@
$(MC_PROG): $(MDBCOMP_DIR)/lib$(MDBCOMP_LIB_NAME).$A
$(MC_PROG): $(BROWSER_DIR)/lib$(BROWSER_LIB_NAME).$A
$(MC_PROG): $(TRACE_DIR)/lib$(TRACE_LIB_NAME).$A
+$(MC_PROG): $(TRACE_DIR)/lib$(EVENTSPEC_LIB_NAME).$A
$(MC_PROG): $(ANALYSIS_DIR)/lib$(ANALYSIS_LIB_NAME).$A
# XXX should also depend on $(BOEHM_GC_DIR)/libgc(_prof).$A, but only
# if in .gc(.prof) grade
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.184
diff -u -b -r1.184 call_gen.m
--- compiler/call_gen.m 15 Oct 2006 23:26:34 -0000 1.184
+++ compiler/call_gen.m 13 Nov 2006 13:49:33 -0000
@@ -244,18 +244,23 @@
code_tree::out, code_info::in, code_info::out) is det.
generate_event_call(EventName, Args, GoalInfo, Code, !CI) :-
- ( event_arg_names(EventName, AttributeNames) ->
+ code_info.get_module_info(!.CI, ModuleInfo),
+ module_info_get_event_spec_map(ModuleInfo, EventSpecMap),
+ (
+ event_arg_names(EventSpecMap, EventName, AttributeNames),
+ event_number(EventSpecMap, EventName, EventNumber)
+ ->
generate_event_attributes(AttributeNames, Args, Attributes, AttrCodes,
!CI),
- SolverEventInfo = solver_event_info(EventName, Attributes),
- generate_solver_event_code(SolverEventInfo, GoalInfo, EventCode, !CI),
+ UserEventInfo = user_event_info(EventNumber, EventName, Attributes),
+ generate_user_event_code(UserEventInfo, GoalInfo, EventCode, !CI),
Code = tree(tree_list(AttrCodes), EventCode)
;
unexpected(this_file, "generate_event_call: bad event name")
).
:- pred generate_event_attributes(list(string)::in, list(prog_var)::in,
- list(solver_attribute)::out, list(code_tree)::out,
+ list(user_attribute)::out, list(code_tree)::out,
code_info::in, code_info::out) is det.
generate_event_attributes([], [], [], [], !CI).
@@ -267,7 +272,7 @@
[Code | Codes], !CI) :-
produce_variable(Var, Code, Rval, !CI),
Type = variable_type(!.CI, Var),
- Attr = solver_attribute(Rval, Type, Name),
+ Attr = user_attribute(Rval, Type, Name),
generate_event_attributes(Names, Vars, Attrs, Codes, !CI).
%---------------------------------------------------------------------------%
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.333
diff -u -b -r1.333 code_info.m
--- compiler/code_info.m 15 Oct 2006 23:26:35 -0000 1.333
+++ compiler/code_info.m 13 Nov 2006 13:30:22 -0000
@@ -739,7 +739,7 @@
:- pred succip_is_used(code_info::in, code_info::out) is det.
:- pred add_trace_layout_for_label(label::in, term.context::in,
- trace_port::in, bool::in, goal_path::in, maybe(solver_event_info)::in,
+ trace_port::in, bool::in, goal_path::in, maybe(user_event_info)::in,
layout_label_info::in, code_info::in, code_info::out) is det.
:- pred get_cur_proc_label(code_info::in, proc_label::out) is det.
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.98
diff -u -b -r1.98 compile_target_code.m
--- compiler/compile_target_code.m 17 Nov 2006 05:23:25 -0000 1.98
+++ compiler/compile_target_code.m 19 Nov 2006 23:02:30 -0000
@@ -1389,15 +1389,16 @@
(
Demangle = yes,
globals.io_lookup_string_option(demangle_command,
- DemamngleCmd, !IO),
- MaybeDemangleCmd = yes(DemamngleCmd)
+ DemangleCmd, !IO),
+ MaybeDemangleCmd = yes(DemangleCmd)
;
Demangle = no,
MaybeDemangleCmd = no
),
- invoke_system_command(ErrorStream, cmd_verbose_commands, LinkCmd,
- MaybeDemangleCmd, LinkSucceeded, !IO)
+ invoke_system_command_maybe_filter_output(ErrorStream,
+ cmd_verbose_commands, LinkCmd, MaybeDemangleCmd, LinkSucceeded,
+ !IO)
;
LibrariesSucceeded = no,
LinkSucceeded = no
@@ -1511,15 +1512,19 @@
("libmer_trace" ++ LibExt)) ++
" " ++
quote_arg(StdLibDir/"lib"/GradeDir/
+ ("libmer_event_spec" ++ LibExt)) ++
+ " " ++
+ quote_arg(StdLibDir/"lib"/GradeDir/
("libmer_browser" ++ LibExt)) ++
" " ++
quote_arg(StdLibDir/"lib"/GradeDir/
("libmer_mdbcomp" ++ LibExt)),
make_link_lib(TargetType, "mer_trace", TraceLib, !IO),
+ make_link_lib(TargetType, "mer_eventspec", EventSpecLib, !IO),
make_link_lib(TargetType, "mer_browser", BrowserLib, !IO),
make_link_lib(TargetType, "mer_mdbcomp", MdbCompLib, !IO),
SharedTraceLibs = string.join_list(" ",
- [TraceLib, BrowserLib, MdbCompLib])
+ [TraceLib, EventSpecLib, BrowserLib, MdbCompLib])
),
globals.io_lookup_string_option(mercury_linkage, MercuryLinkage, !IO),
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.82
diff -u -b -r1.82 continuation_info.m
--- compiler/continuation_info.m 15 Oct 2006 23:26:37 -0000 1.82
+++ compiler/continuation_info.m 13 Nov 2006 13:07:19 -0000
@@ -243,7 +243,7 @@
port_type :: trace_port,
port_is_hidden :: bool,
port_path :: goal_path,
- port_solver :: maybe(solver_event_info),
+ port_user :: maybe(user_event_info),
port_label :: layout_label_info
).
@@ -272,17 +272,18 @@
% layout_var_info was created
).
-:- type solver_attribute
- ---> solver_attribute(
+:- type user_attribute
+ ---> user_attribute(
attr_locn :: rval,
attr_type :: mer_type,
attr_name :: string
).
-:- type solver_event_info
- ---> solver_event_info(
- solver_port :: string,
- solver_attributes :: list(solver_attribute)
+:- type user_event_info
+ ---> user_event_info(
+ user_port_number :: int,
+ user_port_name :: string,
+ user_attributes :: list(user_attribute)
).
:- type closure_layout_info
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.74
diff -u -b -r1.74 equiv_type.m
--- compiler/equiv_type.m 1 Nov 2006 06:32:49 -0000 1.74
+++ compiler/equiv_type.m 13 Nov 2006 14:52:34 -0000
@@ -31,13 +31,13 @@
%-----------------------------------------------------------------------------%
- % expand_eqv_types(ModuleName, Items0, Items, CircularTypes, EqvMap,
- % !MaybeRecompInfo, Specs).
+ % expand_eqv_types(ModuleName, !Items, !EventSpecMap,
+ % CircularTypes, EqvMap, !MaybeRecompInfo, Specs):
%
% First it builds up a map from type_ctor to the equivalent type.
- % Then it traverses through the list of items, expanding all types.
- % This has the effect of eliminating all the equivalence types
- % from the source code.
+ % Then it traverses through the list of items and event specs,
+ % expanding all types. This has the effect of eliminating all the
+ % equivalence types from the source code.
%
% `with_type` and `with_inst` annotations on predicate and
% function type declarations are also expaneded.
@@ -51,6 +51,7 @@
%
:- pred expand_eqv_types(module_name::in,
list(item_and_context)::in, list(item_and_context)::out,
+ event_spec_map::in, event_spec_map::out,
eqv_map::out, used_modules::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out,
list(error_spec)::out) is det.
@@ -96,8 +97,7 @@
% that declaration also depend on the expanded items.
%
:- pred maybe_record_expanded_items(module_name::in,
- sym_name::in, maybe(recompilation_info)::in,
- equiv_type_info::out) is det.
+ sym_name::in, maybe(recompilation_info)::in, equiv_type_info::out) is det.
% Record all the expanded items in the recompilation_info.
%
@@ -140,15 +140,20 @@
% First we build up a mapping which records the equivalence type
% definitions. Then we go through the item list and replace them.
%
-expand_eqv_types(ModuleName, Items0, Items, EqvMap, UsedModules, !Info,
- Specs) :-
+expand_eqv_types(ModuleName, Items0, Items, EventSpecMap0, EventSpecMap,
+ EqvMap, !:UsedModules, !RecompInfo, !:Specs) :-
map.init(EqvMap0),
map.init(EqvInstMap0),
build_eqv_map(Items0, EqvMap0, EqvMap, EqvInstMap0, EqvInstMap),
+ !:UsedModules = used_modules_init,
+ !:Specs = [],
replace_in_item_list(ModuleName, eqv_type_out_of_module, Items0,
- EqvMap, EqvInstMap, [], RevItems, !Info,
- used_modules_init, UsedModules, [], Specs),
- list.reverse(RevItems, Items).
+ EqvMap, EqvInstMap, [], RevItems, !RecompInfo, !UsedModules, !Specs),
+ list.reverse(RevItems, Items),
+ map.to_assoc_list(EventSpecMap0, EventSpecList0),
+ replace_in_event_spec_list(EventSpecList0, EventSpecList,
+ EqvMap, EqvInstMap, !RecompInfo, !UsedModules, !Specs),
+ map.from_assoc_list(EventSpecList, EventSpecMap).
% We need to expand equivalence insts in
% `:- pred p `with_inst` i' declarations.
@@ -170,14 +175,20 @@
build_eqv_map([], !EqvMap, !EqvInstMap).
build_eqv_map([Item - _Context | Items0], !EqvMap, !EqvInstMap) :-
- ( Item = item_module_defn(_, md_abstract_imported) ->
+ (
+ Item = item_module_defn(_, md_abstract_imported)
+ ->
skip_abstract_imported_items(Items0, Items)
- ; Item = item_type_defn(VarSet, Name, Args, parse_tree_eqv_type(Body), _) ->
+ ;
+ Item = item_type_defn(VarSet, Name, Args, parse_tree_eqv_type(Body), _)
+ ->
Items = Items0,
list.length(Args, Arity),
TypeCtor = type_ctor(Name, Arity),
svmap.set(TypeCtor, eqv_type_body(VarSet, Args, Body), !EqvMap)
- ; Item = item_inst_defn(VarSet, Name, Args, eqv_inst(Body), _) ->
+ ;
+ Item = item_inst_defn(VarSet, Name, Args, eqv_inst(Body), _)
+ ->
Items = Items0,
list.length(Args, Arity),
InstId = inst_id(Name, Arity),
@@ -233,9 +244,10 @@
used_modules::in, used_modules::out,
list(error_spec)::in, list(error_spec)::out) is det.
-replace_in_item_list(_, _, [], _, _, !Items, !Info, !UsedModules, !Specs).
+replace_in_item_list(_, _, [], _, _, !Items, !RecompInfo, !UsedModules,
+ !Specs).
replace_in_item_list(ModuleName, Location0, [ItemAndContext0 | Items0],
- EqvMap, EqvInstMap, !ReplItems, !Info, !UsedModules, !Specs) :-
+ EqvMap, EqvInstMap, !ReplItems, !RecompInfo, !UsedModules, !Specs) :-
ItemAndContext0 = Item0 - Context,
( Item0 = item_module_defn(_, ModuleDefn) ->
( ModuleDefn = md_interface,
@@ -273,7 +285,7 @@
),
(
replace_in_item(ModuleName, Location, Item0, Context, EqvMap,
- EqvInstMap, Item, !Info, !UsedModules, ItemSpecs)
+ EqvInstMap, Item, !RecompInfo, !UsedModules, ItemSpecs)
->
ItemAndContext = Item - Context,
% Discard the item if there were any errors.
@@ -289,7 +301,7 @@
!:ReplItems = [ItemAndContext | !.ReplItems]
),
replace_in_item_list(ModuleName, Location, Items0, EqvMap, EqvInstMap,
- !ReplItems, !Info, !UsedModules, !Specs).
+ !ReplItems, !RecompInfo, !UsedModules, !Specs).
:- pred replace_in_item(module_name::in, eqv_type_location::in, item::in,
prog_context::in, eqv_map::in, eqv_inst_map::in, item::out,
@@ -300,9 +312,10 @@
item_type_defn(VarSet0, SymName, TArgs, TypeDefn0, Cond),
Context, EqvMap, _EqvInstMap,
item_type_defn(VarSet, SymName, TArgs, TypeDefn, Cond),
- !Info, !UsedModules, Specs) :-
+ !RecompInfo, !UsedModules, Specs) :-
list.length(TArgs, Arity),
- maybe_record_expanded_items(ModuleName, SymName, !.Info, UsedTypeCtors0),
+ maybe_record_expanded_items(ModuleName, SymName, !.RecompInfo,
+ UsedTypeCtors0),
replace_in_type_defn(Location, EqvMap, type_ctor(SymName, Arity),
TypeDefn0, TypeDefn, ContainsCirc, VarSet0, VarSet,
UsedTypeCtors0, UsedTypeCtors, !UsedModules),
@@ -322,7 +335,7 @@
Specs = []
),
ItemId = item_id(type_body_item, item_name(SymName, Arity)),
- finish_recording_expanded_items(ItemId, UsedTypeCtors, !Info).
+ finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo).
replace_in_item(ModuleName, Location,
item_pred_or_func(Origin, TypeVarSet0, InstVarSet, ExistQVars,
@@ -332,8 +345,9 @@
item_pred_or_func(Origin, TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, MaybeWithType,
MaybeWithInst, Det, Cond, Purity, ClassContext),
- !Info, !UsedModules, Specs) :-
- maybe_record_expanded_items(ModuleName, PredName, !.Info, ExpandedItems0),
+ !RecompInfo, !UsedModules, Specs) :-
+ maybe_record_expanded_items(ModuleName, PredName, !.RecompInfo,
+ ExpandedItems0),
replace_in_pred_type(Location, PredName, PredOrFunc, Context, EqvMap,
EqvInstMap, ClassContext0, ClassContext,
@@ -345,7 +359,7 @@
list.length(TypesAndModes, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
ItemId = item_id(ItemType, item_name(PredName, OrigArity)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo).
replace_in_item(ModuleName, Location,
item_pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
@@ -353,8 +367,9 @@
Context, _EqvMap, EqvInstMap,
item_pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
Modes, WithInst, Det, Cond),
- !Info, !UsedModules, Specs) :-
- maybe_record_expanded_items(ModuleName, PredName, !.Info, ExpandedItems0),
+ !RecompInfo, !UsedModules, Specs) :-
+ maybe_record_expanded_items(ModuleName, PredName, !.RecompInfo,
+ ExpandedItems0),
replace_in_pred_mode(Location, PredName, length(Modes0), Context,
mode_decl, EqvInstMap, ExtraModes, MaybePredOrFunc0, MaybePredOrFunc,
@@ -373,7 +388,7 @@
list.length(Modes, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
ItemId = item_id(ItemType, item_name(PredName, OrigArity)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !Info)
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo)
;
MaybePredOrFunc = no
).
@@ -384,9 +399,10 @@
_Context, EqvMap, EqvInstMap,
item_typeclass(Constraints, FunDeps, ClassName, Vars,
ClassInterface, VarSet),
- !Info, !UsedModules, Specs) :-
+ !RecompInfo, !UsedModules, Specs) :-
list.length(Vars, Arity),
- maybe_record_expanded_items(ModuleName, ClassName, !.Info, ExpandedItems0),
+ maybe_record_expanded_items(ModuleName, ClassName, !.RecompInfo,
+ ExpandedItems0),
replace_in_prog_constraint_list(Location, EqvMap,
Constraints0, Constraints, VarSet0, VarSet,
ExpandedItems0, ExpandedItems1, !UsedModules),
@@ -402,7 +418,7 @@
ClassInterface = class_interface_concrete(Methods)
),
ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo).
replace_in_item(ModuleName, Location,
item_instance(Constraints0, ClassName, Ts0, InstanceBody, VarSet0,
@@ -410,9 +426,9 @@
_Context, EqvMap, _EqvInstMap,
item_instance(Constraints, ClassName, Ts, InstanceBody, VarSet,
ModName),
- !Info, !UsedModules, []) :-
+ !RecompInfo, !UsedModules, []) :-
(
- ( !.Info = no
+ ( !.RecompInfo = no
; ModName = ModuleName
)
->
@@ -427,7 +443,7 @@
VarSet1, VarSet, UsedTypeCtors1, UsedTypeCtors, !UsedModules),
list.length(Ts0, Arity),
ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
- finish_recording_expanded_items(ItemId, UsedTypeCtors, !Info).
+ finish_recording_expanded_items(ItemId, UsedTypeCtors, !RecompInfo).
replace_in_item(ModuleName, Location,
item_pragma(Origin, pragma_type_spec(PredName, NewName, Arity, PorF,
@@ -435,9 +451,9 @@
_Context, EqvMap, _EqvInstMap,
item_pragma(Origin, pragma_type_spec(PredName, NewName, Arity, PorF,
Modes, Subst, VarSet, ItemIds)),
- !Info, !UsedModules, []) :-
+ !RecompInfo, !UsedModules, []) :-
(
- ( !.Info = no
+ ( !.RecompInfo = no
; PredName = qualified(ModuleName, _)
)
->
@@ -460,10 +476,10 @@
_Context, EqvMap, _EqvInstMap,
item_pragma(Origin, pragma_foreign_proc(Attrs, PName, PredOrFunc,
ProcVars, ProcVarset, ProcInstVarset, ProcImpl)),
- !Info, !UsedModules, []) :-
+ !RecompInfo, !UsedModules, []) :-
some [!EquivTypeInfo] (
maybe_record_expanded_items(ModuleName, PName,
- !.Info, !:EquivTypeInfo),
+ !.RecompInfo, !:EquivTypeInfo),
UserSharing0 = get_user_annotated_sharing(Attrs0),
(
UserSharing0 = user_sharing(Sharing0, MaybeTypes0),
@@ -483,23 +499,90 @@
),
ItemId = item_id(foreign_proc_item, item_name(PName,
list.length(ProcVars))),
- finish_recording_expanded_items(ItemId, !.EquivTypeInfo, !Info)
+ finish_recording_expanded_items(ItemId, !.EquivTypeInfo, !RecompInfo)
).
replace_in_item(ModuleName, Location,
item_mutable(MutName, Type0, InitValue, Inst0, Attrs, Varset),
_Context, EqvMap, EqvInstMap,
item_mutable(MutName, Type, InitValue, Inst, Attrs, Varset),
- !Info, !UsedModules, []) :-
+ !RecompInfo, !UsedModules, []) :-
QualName = qualified(ModuleName, MutName),
- maybe_record_expanded_items(ModuleName, QualName, !.Info, ExpandedItems0),
+ maybe_record_expanded_items(ModuleName, QualName, !.RecompInfo,
+ ExpandedItems0),
TVarSet0 = varset.init,
replace_in_type_location(Location, EqvMap, Type0, Type, _TypeChanged,
TVarSet0, _TVarSet, ExpandedItems0, ExpandedItems1, !UsedModules),
replace_in_inst(Location, Inst0, EqvInstMap, Inst,
ExpandedItems1, ExpandedItems, !UsedModules),
ItemId = item_id(mutable_item, item_name(QualName, 0)),
- finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
+ finish_recording_expanded_items(ItemId, ExpandedItems, !RecompInfo).
+
+:- pred replace_in_event_spec_list(
+ assoc_list(string, event_spec)::in, assoc_list(string, event_spec)::out,
+ eqv_map::in, eqv_inst_map::in,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+replace_in_event_spec_list([], [], _, _, !RecompInfo, !UsedModules, !Specs).
+replace_in_event_spec_list(
+ [Name - EventSpec0 | NameSpecs0], [Name - EventSpec | NameSpecs],
+ EqvMap, EqvInstMap, !RecompInfo, !UsedModules, !Specs) :-
+ replace_in_event_spec(EventSpec0, EventSpec,
+ EqvMap, EqvInstMap, !RecompInfo, !UsedModules, !Specs),
+ replace_in_event_spec_list(NameSpecs0, NameSpecs,
+ EqvMap, EqvInstMap, !RecompInfo, !UsedModules, !Specs).
+
+:- pred replace_in_event_spec(event_spec::in, event_spec::out,
+ eqv_map::in, eqv_inst_map::in,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+replace_in_event_spec(EventSpec0, EventSpec, EqvMap, EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs) :-
+ EventSpec0 = event_spec(EventNumber, EventLineNumber,
+ VisAttrs0, AllAttrs0),
+ replace_in_event_attrs(VisAttrs0, VisAttrs, EqvMap, EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs),
+ replace_in_event_attrs(AllAttrs0, AllAttrs, EqvMap, EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs),
+ EventSpec = event_spec(EventNumber, EventLineNumber,
+ VisAttrs, AllAttrs).
+
+:- pred replace_in_event_attrs(
+ list(event_attribute)::in, list(event_attribute)::out,
+ eqv_map::in, eqv_inst_map::in,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+replace_in_event_attrs([], [], _EqvMap, _EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs).
+replace_in_event_attrs([Attr0 | Attrs0], [Attr | Attrs], EqvMap, EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs) :-
+ replace_in_event_attr(Attr0, Attr, EqvMap, EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs),
+ replace_in_event_attrs(Attrs0, Attrs, EqvMap, EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs).
+
+:- pred replace_in_event_attr(event_attribute::in, event_attribute::out,
+ eqv_map::in, eqv_inst_map::in,
+ maybe(recompilation_info)::in, maybe(recompilation_info)::out,
+ used_modules::in, used_modules::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+replace_in_event_attr(Attr0, Attr, EqvMap, _EqvInstMap,
+ !RecompInfo, !UsedModules, !Specs) :-
+ % We construct the attributes' modes ourselves in event_spec.m; they should
+ % not contain type names.
+ Attr0 = event_attribute(AttrName, AttrType0, AttrMode, MaybeSynthCall),
+ TVarSet0 = varset.init,
+ replace_in_type_location(eqv_type_out_of_module, EqvMap,
+ AttrType0, AttrType, _Changed, TVarSet0, _TVarSet, no, _EquivTypeInfo,
+ !UsedModules),
+ Attr = event_attribute(AttrName, AttrType, AttrMode, MaybeSynthCall).
:- pred replace_in_type_defn(eqv_type_location::in, eqv_map::in, type_ctor::in,
type_defn::in, type_defn::out, bool::out, tvarset::in, tvarset::out,
@@ -507,16 +590,17 @@
used_modules::in, used_modules::out) is semidet.
replace_in_type_defn(Location, EqvMap, TypeCtor, TypeDefn0, TypeDefn,
- ContainsCirc, !VarSet, !Info, !UsedModules) :-
+ ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules) :-
(
TypeDefn0 = parse_tree_eqv_type(TypeBody0),
replace_in_type_location_2(Location, EqvMap, [TypeCtor],
- TypeBody0, TypeBody, _, ContainsCirc, !VarSet, !Info, !UsedModules),
+ TypeBody0, TypeBody, _, ContainsCirc, !VarSet, !EquivTypeInfo,
+ !UsedModules),
TypeDefn = parse_tree_eqv_type(TypeBody)
;
TypeDefn0 = parse_tree_du_type(TypeBody0, EqPred),
replace_in_ctors_location(Location, EqvMap, TypeBody0, TypeBody,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
ContainsCirc = no,
TypeDefn = parse_tree_du_type(TypeBody, EqPred)
;
@@ -525,7 +609,7 @@
GroundInst, AnyInst, MutableItems),
replace_in_type_location_2(Location, EqvMap, [TypeCtor],
RepresentationType0, RepresentationType,
- _, ContainsCirc, !VarSet, !Info, !UsedModules),
+ _, ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules),
SolverDetails = solver_type_details(RepresentationType, InitPred,
GroundInst, AnyInst, MutableItems),
TypeDefn = parse_tree_solver_type(SolverDetails, MaybeUserEqComp)
@@ -533,22 +617,22 @@
%-----------------------------------------------------------------------------%
-replace_in_prog_constraints(EqvMap, Cs0, Cs, !VarSet, !Info) :-
+replace_in_prog_constraints(EqvMap, Cs0, Cs, !VarSet, !EquivTypeInfo) :-
replace_in_prog_constraints_location(eqv_type_out_of_module, EqvMap,
- Cs0, Cs, !VarSet, !Info, used_modules_init, _).
+ Cs0, Cs, !VarSet, !EquivTypeInfo, used_modules_init, _).
:- pred replace_in_prog_constraints_location(eqv_type_location::in,
eqv_map::in, prog_constraints::in, prog_constraints::out,
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_prog_constraints_location(Location, EqvMap, Cs0, Cs, !VarSet, !Info,
- !UsedModules) :-
+replace_in_prog_constraints_location(Location, EqvMap, Cs0, Cs, !VarSet,
+ !EquivTypeInfo, !UsedModules) :-
Cs0 = constraints(UnivCs0, ExistCs0),
replace_in_prog_constraint_list(Location, EqvMap, UnivCs0, UnivCs,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
replace_in_prog_constraint_list(Location, EqvMap, ExistCs0, ExistCs,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
Cs = constraints(UnivCs, ExistCs).
:- pred replace_in_prog_constraint_list(eqv_type_location::in, eqv_map::in,
@@ -556,14 +640,16 @@
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_prog_constraint_list(Location, EqvMap, !Cs, !VarSet, !Info,
+replace_in_prog_constraint_list(Location, EqvMap, !Cs, !VarSet, !EquivTypeInfo,
!UsedModules) :-
list.map_foldl3(replace_in_prog_constraint_location(Location, EqvMap),
- !Cs, !VarSet, !Info, !UsedModules).
+ !Cs, !VarSet, !EquivTypeInfo, !UsedModules).
-replace_in_prog_constraint(EqvMap, Constraint0, Constraint, !VarSet, !Info) :-
+replace_in_prog_constraint(EqvMap, Constraint0, Constraint, !VarSet,
+ !EquivTypeInfo) :-
replace_in_prog_constraint_location(eqv_type_out_of_module, EqvMap,
- Constraint0, Constraint, !VarSet, !Info, used_modules_init, _).
+ Constraint0, Constraint, !VarSet, !EquivTypeInfo,
+ used_modules_init, _).
:- pred replace_in_prog_constraint_location(eqv_type_location::in, eqv_map::in,
prog_constraint::in, prog_constraint::out, tvarset::in, tvarset::out,
@@ -571,10 +657,10 @@
used_modules::in, used_modules::out) is det.
replace_in_prog_constraint_location(Location, EqvMap, Constraint0, Constraint,
- !VarSet, !Info, !UsedModules) :-
+ !VarSet, !EquivTypeInfo, !UsedModules) :-
Constraint0 = constraint(ClassName, Ts0),
replace_in_type_list_location_circ(Location, EqvMap, Ts0, Ts, _, _,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
Constraint = constraint(ClassName, Ts).
%-----------------------------------------------------------------------------%
@@ -586,9 +672,9 @@
list(error_spec)::in, list(error_spec)::out) is det.
replace_in_class_interface(Location, ClassInterface0, EqvMap, EqvInstMap,
- ClassInterface, !Info, !UsedModules, !Specs) :-
+ ClassInterface, !EquivTypeInfo, !UsedModules, !Specs) :-
list.map_foldl3(replace_in_class_method(Location, EqvMap, EqvInstMap),
- ClassInterface0, ClassInterface, !Info, !UsedModules, !Specs).
+ ClassInterface0, ClassInterface, !EquivTypeInfo, !UsedModules, !Specs).
:- pred replace_in_class_method(eqv_type_location::in,
eqv_map::in, eqv_inst_map::in, class_method::in, class_method::out,
@@ -597,7 +683,7 @@
list(error_spec)::in, list(error_spec)::out) is det.
replace_in_class_method(Location, EqvMap, EqvInstMap, Method0, Method,
- !Info, !UsedModules, !Specs) :-
+ !EquivTypeInfo, !UsedModules, !Specs) :-
(
Method0 = method_pred_or_func(TypeVarSet0, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes0, WithType0, WithInst0,
@@ -606,7 +692,7 @@
EqvInstMap, ClassContext0, ClassContext,
TypesAndModes0, TypesAndModes, TypeVarSet0, TypeVarSet,
WithType0, WithType, WithInst0, WithInst, Det0, Det,
- !Info, !UsedModules, NewSpecs),
+ !EquivTypeInfo, !UsedModules, NewSpecs),
!:Specs = NewSpecs ++ !.Specs,
Method = method_pred_or_func(TypeVarSet, InstVarSet, ExistQVars,
PredOrFunc, PredName, TypesAndModes, WithType, WithInst,
@@ -617,7 +703,7 @@
replace_in_pred_mode(Location, PredName, length(Modes0), Context,
mode_decl, EqvInstMap, ExtraModes,
MaybePredOrFunc0, MaybePredOrFunc, WithInst0, WithInst,
- Det0, Det, !Info, !UsedModules, NewSpecs),
+ Det0, Det, !EquivTypeInfo, !UsedModules, NewSpecs),
(
ExtraModes = [],
Modes = Modes0
@@ -637,29 +723,31 @@
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_subst(_Location, _EqvMap, [], [], !VarSet, !Info, !UsedModules).
+replace_in_subst(_Location, _EqvMap, [], [], !VarSet, !EquivTypeInfo,
+ !UsedModules).
replace_in_subst(Location, EqvMap, [Var - Type0 | Subst0],
- [Var - Type | Subst], !VarSet, !Info, !UsedModules) :-
- replace_in_type_location(Location, EqvMap, Type0, Type, _, !VarSet, !Info,
+ [Var - Type | Subst], !VarSet, !EquivTypeInfo, !UsedModules) :-
+ replace_in_type_location(Location, EqvMap, Type0, Type, _, !VarSet,
+ !EquivTypeInfo,
!UsedModules),
- replace_in_subst(Location, EqvMap, Subst0, Subst, !VarSet, !Info,
+ replace_in_subst(Location, EqvMap, Subst0, Subst, !VarSet, !EquivTypeInfo,
!UsedModules).
%-----------------------------------------------------------------------------%
-replace_in_ctors(EqvMap, !Ctors, !VarSet, !Info) :-
+replace_in_ctors(EqvMap, !Ctors, !VarSet, !EquivTypeInfo) :-
replace_in_ctors_location(eqv_type_out_of_module, EqvMap, !Ctors, !VarSet,
- !Info, used_modules_init, _).
+ !EquivTypeInfo, used_modules_init, _).
:- pred replace_in_ctors_location(eqv_type_location::in, eqv_map::in,
list(constructor)::in, list(constructor)::out,
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_ctors_location(Location, EqvMap, !Ctors, !VarSet, !Info,
+replace_in_ctors_location(Location, EqvMap, !Ctors, !VarSet, !EquivTypeInfo,
!UsedModules) :-
- list.map_foldl3(replace_in_ctor(Location, EqvMap), !Ctors, !VarSet, !Info,
- !UsedModules).
+ list.map_foldl3(replace_in_ctor(Location, EqvMap), !Ctors, !VarSet,
+ !EquivTypeInfo, !UsedModules).
:- pred replace_in_ctor(eqv_type_location::in, eqv_map::in,
constructor::in, constructor::out, tvarset::in, tvarset::out,
@@ -669,17 +757,17 @@
replace_in_ctor(Location, EqvMap,
ctor(ExistQVars, Constraints0, TName, Targs0, Ctxt),
ctor(ExistQVars, Constraints, TName, Targs, Ctxt),
- !VarSet, !Info, !UsedModules) :-
+ !VarSet, !EquivTypeInfo, !UsedModules) :-
replace_in_ctor_arg_list(Location,
- EqvMap, Targs0, Targs, _, !VarSet, !Info, !UsedModules),
+ EqvMap, Targs0, Targs, _, !VarSet, !EquivTypeInfo, !UsedModules),
replace_in_prog_constraint_list(Location, EqvMap,
- Constraints0, Constraints, !VarSet, !Info, !UsedModules).
+ Constraints0, Constraints, !VarSet, !EquivTypeInfo, !UsedModules).
%-----------------------------------------------------------------------------%
-replace_in_type_list(EqvMap, !Ts, Changed, !VarSet, !Info) :-
+replace_in_type_list(EqvMap, !Ts, Changed, !VarSet, !EquivTypeInfo) :-
replace_in_type_list_location(eqv_type_out_of_module, EqvMap, !Ts, Changed,
- !VarSet, !Info, used_modules_init, _).
+ !VarSet, !EquivTypeInfo, used_modules_init, _).
:- pred replace_in_type_list_location(eqv_type_location::in, eqv_map::in,
list(mer_type)::in, list(mer_type)::out, bool::out,
@@ -687,10 +775,10 @@
equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_type_list_location(Location, EqvMap, !Ts, Changed, !VarSet, !Info,
- !UsedModules) :-
+replace_in_type_list_location(Location, EqvMap, !Ts, Changed, !VarSet,
+ !EquivTypeInfo, !UsedModules) :-
replace_in_type_list_location_circ_2(Location, EqvMap, [], !Ts, Changed,
- no, _, !VarSet, !Info, !UsedModules).
+ no, _, !VarSet, !EquivTypeInfo, !UsedModules).
:- pred replace_in_type_list_location_circ(eqv_type_location::in, eqv_map::in,
list(mer_type)::in, list(mer_type)::out, bool::out, bool::out,
@@ -698,9 +786,9 @@
used_modules::in, used_modules::out) is det.
replace_in_type_list_location_circ(Location, EqvMap, !Ts,
- Changed, ContainsCirc, !VarSet, !Info, !UsedModules) :-
+ Changed, ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules) :-
replace_in_type_list_location_circ_2(Location, EqvMap, [], !Ts,
- Changed, no, ContainsCirc, !VarSet, !Info, !UsedModules).
+ Changed, no, ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules).
:- pred replace_in_type_list_location_circ_2(eqv_type_location::in,
eqv_map::in, list(type_ctor)::in, list(mer_type)::in, list(mer_type)::out,
@@ -709,15 +797,15 @@
used_modules::in, used_modules::out) is det.
replace_in_type_list_location_circ_2(_Location, _EqvMap, _Seen, [], [], no,
- !ContainsCirc, !VarSet, !Info, !UsedModules).
+ !ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules).
replace_in_type_list_location_circ_2(Location, EqvMap, Seen,
- List0 @ [T0 | Ts0], List, Changed, !Circ, !VarSet, !Info,
+ List0 @ [T0 | Ts0], List, Changed, !Circ, !VarSet, !EquivTypeInfo,
!UsedModules) :-
replace_in_type_location_2(Location, EqvMap, Seen, T0, T, Changed0,
- ContainsCirc, !VarSet, !Info, !UsedModules),
+ ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules),
!:Circ = ContainsCirc `or` !.Circ,
replace_in_type_list_location_circ_2(Location, EqvMap, Seen, Ts0, Ts,
- Changed1, !Circ, !VarSet, !Info, !UsedModules),
+ Changed1, !Circ, !VarSet, !EquivTypeInfo, !UsedModules),
(
( Changed0 = yes
; Changed1 = yes
@@ -738,9 +826,9 @@
used_modules::in, used_modules::out) is det.
replace_in_ctor_arg_list(Location,
- EqvMap, !As, ContainsCirc, !VarSet, !Info, !UsedModules) :-
+ EqvMap, !As, ContainsCirc, !VarSet, !EquivTypeInfo, !UsedModules) :-
replace_in_ctor_arg_list_2(Location, EqvMap, [], !As, no, ContainsCirc,
- !VarSet, !Info, !UsedModules).
+ !VarSet, !EquivTypeInfo, !UsedModules).
:- pred replace_in_ctor_arg_list_2(eqv_type_location::in,
eqv_map::in, list(type_ctor)::in,
@@ -750,21 +838,21 @@
used_modules::in, used_modules::out) is det.
replace_in_ctor_arg_list_2(_Location, _EqvMap, _Seen, [], [],
- !Circ, !VarSet, !Info, !UsedModules).
+ !Circ, !VarSet, !EquivTypeInfo, !UsedModules).
replace_in_ctor_arg_list_2(Location, EqvMap, Seen,
[ctor_arg(N, T0, C) | As0], [ctor_arg(N, T, C) | As],
- !Circ, !VarSet, !Info, !UsedModules) :-
+ !Circ, !VarSet, !EquivTypeInfo, !UsedModules) :-
replace_in_type_location_2(Location, EqvMap, Seen, T0, T, _, ContainsCirc,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
!:Circ = !.Circ `or` ContainsCirc,
replace_in_ctor_arg_list_2(Location, EqvMap,
- Seen, As0, As, !Circ, !VarSet, !Info, !UsedModules).
+ Seen, As0, As, !Circ, !VarSet, !EquivTypeInfo, !UsedModules).
%-----------------------------------------------------------------------------%
-replace_in_type(EqvMap, Type0, Type, Changed, !VarSet, !Info) :-
+replace_in_type(EqvMap, Type0, Type, Changed, !VarSet, !EquivTypeInfo) :-
replace_in_type_location(eqv_type_out_of_module, EqvMap, Type0, Type,
- Changed, !VarSet, !Info, used_modules_init, _).
+ Changed, !VarSet, !EquivTypeInfo, used_modules_init, _).
:- pred replace_in_type_location(eqv_type_location::in, eqv_map::in,
mer_type::in, mer_type::out, bool::out, tvarset::in, tvarset::out,
@@ -772,9 +860,9 @@
used_modules::in, used_modules::out) is det.
replace_in_type_location(Location, EqvMap, Type0, Type, Changed, !VarSet,
- !Info, !UsedModules) :-
+ !EquivTypeInfo, !UsedModules) :-
replace_in_type_location_2(Location, EqvMap, [], Type0, Type, Changed, _,
- !VarSet, !Info, !UsedModules).
+ !VarSet, !EquivTypeInfo, !UsedModules).
% Replace all equivalence types in a given type, detecting
% any circularities.
@@ -785,7 +873,7 @@
used_modules::in, used_modules::out) is det.
replace_in_type_location_2(Location, EqvMap, TypeCtorsAlreadyExpanded,
- Type0, Type, Changed, Circ, !VarSet, !Info, !UsedModules) :-
+ Type0, Type, Changed, Circ, !VarSet, !EquivTypeInfo, !UsedModules) :-
(
Type0 = type_variable(Var, Kind),
Type = type_variable(Var, Kind),
@@ -795,12 +883,12 @@
Type0 = defined_type(SymName, TArgs0, Kind),
replace_in_type_list_location_circ_2(Location, EqvMap,
TypeCtorsAlreadyExpanded, TArgs0, TArgs, ArgsChanged, no, Circ0,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
Arity = list.length(TArgs),
TypeCtor = type_ctor(SymName, Arity),
replace_type_ctor(Location, EqvMap, TypeCtorsAlreadyExpanded,
Type0, TypeCtor, TArgs, Kind, Type, ArgsChanged, Changed,
- Circ0, Circ, !VarSet, !Info, !UsedModules)
+ Circ0, Circ, !VarSet, !EquivTypeInfo, !UsedModules)
;
Type0 = builtin_type(_),
Type = Type0,
@@ -810,12 +898,12 @@
Type0 = higher_order_type(Args0, MaybeRet0, Purity, EvalMethod),
replace_in_type_list_location_circ_2(Location, EqvMap,
TypeCtorsAlreadyExpanded, Args0, Args, ArgsChanged, no, ArgsCirc,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
(
MaybeRet0 = yes(Ret0),
replace_in_type_location_2(Location, EqvMap,
TypeCtorsAlreadyExpanded, Ret0, Ret, RetChanged, RetCirc,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
MaybeRet = yes(Ret),
Changed = bool.or(ArgsChanged, RetChanged),
Circ = bool.or(ArgsCirc, RetCirc)
@@ -836,7 +924,7 @@
Type0 = tuple_type(Args0, Kind),
replace_in_type_list_location_circ_2(Location, EqvMap,
TypeCtorsAlreadyExpanded, Args0, Args, Changed, no, Circ,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
(
Changed = yes,
Type = tuple_type(Args, Kind)
@@ -848,7 +936,7 @@
Type0 = apply_n_type(Var, Args0, Kind),
replace_in_type_list_location_circ_2(Location, EqvMap,
TypeCtorsAlreadyExpanded, Args0, Args, Changed, no, Circ,
- !VarSet, !Info, !UsedModules),
+ !VarSet, !EquivTypeInfo, !UsedModules),
(
Changed = yes,
Type = apply_n_type(Var, Args, Kind)
@@ -859,7 +947,8 @@
;
Type0 = kinded_type(RawType0, Kind),
replace_in_type_location_2(Location, EqvMap, TypeCtorsAlreadyExpanded,
- RawType0, RawType, Changed, Circ, !VarSet, !Info, !UsedModules),
+ RawType0, RawType, Changed, Circ, !VarSet, !EquivTypeInfo,
+ !UsedModules),
(
Changed = yes,
Type = kinded_type(RawType, Kind)
@@ -876,7 +965,7 @@
used_modules::in, used_modules::out) is det.
replace_type_ctor(Location, EqvMap, TypeCtorsAlreadyExpanded, Type0,
- TypeCtor, TArgs, Kind, Type, !Changed, !Circ, !VarSet, !Info,
+ TypeCtor, TArgs, Kind, Type, !Changed, !Circ, !VarSet, !EquivTypeInfo,
!UsedModules) :-
( list.member(TypeCtor, TypeCtorsAlreadyExpanded) ->
AlreadyExpanded = yes
@@ -905,12 +994,12 @@
map.apply_to_list(Args0, Renaming, Args),
apply_variable_renaming_to_type(Renaming, Body0, Body1),
TypeCtorItem = type_ctor_to_item_name(TypeCtor),
- record_expanded_item(item_id(type_item, TypeCtorItem), !Info),
+ record_expanded_item(item_id(type_item, TypeCtorItem), !EquivTypeInfo),
map.from_corresponding_lists(Args, TArgs, Subst),
apply_subst_to_type(Subst, Body1, Body),
replace_in_type_location_2(Location, EqvMap,
[TypeCtor | TypeCtorsAlreadyExpanded], Body,
- Type, _, !:Circ, !VarSet, !Info, !UsedModules)
+ Type, _, !:Circ, !VarSet, !EquivTypeInfo, !UsedModules)
;
(
!.Changed = yes,
@@ -939,9 +1028,10 @@
equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_inst(Location, Inst0, EqvInstMap, Inst, !Info, !UsedModules) :-
+replace_in_inst(Location, Inst0, EqvInstMap, Inst,
+ !EquivTypeInfo, !UsedModules) :-
replace_in_inst_location(Location, Inst0, EqvInstMap, set.init, Inst,
- !Info, !UsedModules).
+ !EquivTypeInfo, !UsedModules).
:- pred replace_in_inst_location(eqv_type_location::in, mer_inst::in,
eqv_inst_map::in, set(inst_id)::in, mer_inst::out,
@@ -949,7 +1039,7 @@
used_modules::in, used_modules::out) is det.
replace_in_inst_location(Location, Inst0, EqvInstMap, ExpandedInstIds, Inst,
- !Info, !UsedModules) :-
+ !EquivTypeInfo, !UsedModules) :-
% XXX Need to record the used modules
( Inst0 = defined_inst(user_inst(SymName, ArgInsts)) ->
InstId = inst_id(SymName, length(ArgInsts)),
@@ -963,9 +1053,11 @@
->
inst_substitute_arg_list(EqvInstParams, ArgInsts, EqvInst, Inst1),
InstIdItem = inst_id_to_item_name(InstId),
- record_expanded_item(item_id(inst_item, InstIdItem), !Info),
+ record_expanded_item(item_id(inst_item, InstIdItem),
+ !EquivTypeInfo),
replace_in_inst_location(Location, Inst1, EqvInstMap,
- set.insert(ExpandedInstIds, InstId), Inst, !Info, !UsedModules)
+ set.insert(ExpandedInstIds, InstId), Inst,
+ !EquivTypeInfo, !UsedModules)
;
Inst = Inst0
)
@@ -990,15 +1082,16 @@
EqvMap, EqvInstMap, ClassContext0, ClassContext,
TypesAndModes0, TypesAndModes, !TypeVarSet,
MaybeWithType0, MaybeWithType, MaybeWithInst0, MaybeWithInst,
- !Det, !Info, !UsedModules, !:Specs) :-
+ !Det, !EquivTypeInfo, !UsedModules, !:Specs) :-
replace_in_prog_constraints_location(Location, EqvMap,
- ClassContext0, ClassContext, !TypeVarSet, !Info, !UsedModules),
+ ClassContext0, ClassContext, !TypeVarSet,
+ !EquivTypeInfo, !UsedModules),
replace_in_tms(Location, EqvMap, TypesAndModes0, TypesAndModes1,
- !TypeVarSet, !Info, !UsedModules),
+ !TypeVarSet, !EquivTypeInfo, !UsedModules),
(
MaybeWithType0 = yes(WithType0),
replace_in_type_location(Location, EqvMap, WithType0, WithType, _,
- !TypeVarSet, !Info, !UsedModules),
+ !TypeVarSet, !EquivTypeInfo, !UsedModules),
(
type_is_higher_order_details(WithType, _Purity, PredOrFunc,
_EvalMethod, ExtraTypesPrime)
@@ -1023,7 +1116,7 @@
replace_in_pred_mode(Location, PredName, length(TypesAndModes0),
Context, type_decl, EqvInstMap, ExtraModes, yes(PredOrFunc), _,
- MaybeWithInst0, _, !Det, !Info, !UsedModules, ModeSpecs),
+ MaybeWithInst0, _, !Det, !EquivTypeInfo, !UsedModules, ModeSpecs),
!:Specs = !.Specs ++ ModeSpecs,
(
@@ -1073,7 +1166,7 @@
ExtraTypesAndModes = [_ | _],
OrigItemId = item_id(pred_or_func_to_item_type(PredOrFunc),
item_name(PredName, list.length(TypesAndModes0))),
- record_expanded_item(OrigItemId, !Info),
+ record_expanded_item(OrigItemId, !EquivTypeInfo),
TypesAndModes = TypesAndModes1 ++ ExtraTypesAndModes
).
@@ -1088,12 +1181,12 @@
replace_in_pred_mode(Location, PredName, OrigArity, Context, DeclType,
EqvInstMap, ExtraModes, MaybePredOrFunc0, MaybePredOrFunc,
- MaybeWithInst0, MaybeWithInst, !MaybeDet, !Info, !UsedModules,
+ MaybeWithInst0, MaybeWithInst, !MaybeDet, !EquivTypeInfo, !UsedModules,
Specs) :-
(
MaybeWithInst0 = yes(WithInst0),
- replace_in_inst(Location, WithInst0, EqvInstMap, WithInst, !Info,
- !UsedModules),
+ replace_in_inst(Location, WithInst0, EqvInstMap, WithInst,
+ !EquivTypeInfo, !UsedModules),
(
WithInst = ground(_, GroundInstInfo),
GroundInstInfo = higher_order(HOInst),
@@ -1114,7 +1207,7 @@
),
OrigItemId = item_id(pred_or_func_to_item_type(RecordedPredOrFunc),
item_name(PredName, OrigArity)),
- record_expanded_item(OrigItemId, !Info),
+ record_expanded_item(OrigItemId, !EquivTypeInfo),
Specs = []
;
ExtraModes = [],
@@ -1153,9 +1246,10 @@
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out,
used_modules::in, used_modules::out) is det.
-replace_in_tms(Location, EqvMap, !TMs, !VarSet, !Info, !UsedModules) :-
- list.map_foldl3(replace_in_tm(Location, EqvMap), !TMs, !VarSet, !Info,
- !UsedModules).
+replace_in_tms(Location, EqvMap, !TMs, !VarSet, !EquivTypeInfo,
+ !UsedModules) :-
+ list.map_foldl3(replace_in_tm(Location, EqvMap), !TMs,
+ !VarSet, !EquivTypeInfo, !UsedModules).
:- pred replace_in_tm(eqv_type_location::in, eqv_map::in,
type_and_mode::in, type_and_mode::out, tvarset::in, tvarset::out,
@@ -1163,14 +1257,14 @@
used_modules::in, used_modules::out) is det.
replace_in_tm(Location, EqvMap, type_only(Type0),
- type_only(Type), !VarSet, !Info, !UsedModules) :-
- replace_in_type_location(Location, EqvMap, Type0, Type, _, !VarSet, !Info,
- !UsedModules).
+ type_only(Type), !VarSet, !EquivTypeInfo, !UsedModules) :-
+ replace_in_type_location(Location, EqvMap, Type0, Type, _, !VarSet,
+ !EquivTypeInfo, !UsedModules).
replace_in_tm(Location, EqvMap, type_and_mode(Type0, Mode),
- type_and_mode(Type, Mode), !VarSet, !Info, !UsedModules) :-
- replace_in_type_location(Location, EqvMap, Type0, Type, _, !VarSet, !Info,
- !UsedModules).
+ type_and_mode(Type, Mode), !VarSet, !EquivTypeInfo, !UsedModules) :-
+ replace_in_type_location(Location, EqvMap, Type0, Type, _, !VarSet,
+ !EquivTypeInfo, !UsedModules).
%-----------------------------------------------------------------------------%
%
@@ -1242,8 +1336,8 @@
:- pred record_expanded_item(item_id::in,
equiv_type_info::in, equiv_type_info::out) is det.
-record_expanded_item(Item, !Info) :-
- map_maybe(record_expanded_item_2(Item), !Info).
+record_expanded_item(Item, !EquivTypeInfo) :-
+ map_maybe(record_expanded_item_2(Item), !EquivTypeInfo).
:- pred record_expanded_item_2(item_id::in,
pair(module_name, set(item_id))::in,
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.281
diff -u -b -r1.281 handle_options.m
--- compiler/handle_options.m 17 Nov 2006 05:23:26 -0000 1.281
+++ compiler/handle_options.m 19 Nov 2006 23:02:30 -0000
@@ -369,6 +369,22 @@
some [!Globals] (
globals.io_get_globals(!:Globals, !IO),
+ globals.lookup_string_option(!.Globals, event_spec_file_name,
+ EventSpecFileName0),
+ ( EventSpecFileName0 = "" ->
+ io.get_environment_var("MERCURY_EVENT_SPEC_FILE_NAME",
+ MaybeEventSpecFileName, !IO),
+ (
+ MaybeEventSpecFileName = yes(EventSpecFileName),
+ globals.set_option(event_spec_file_name,
+ string(EventSpecFileName), !Globals)
+ ;
+ MaybeEventSpecFileName = no
+ )
+ ;
+ true
+ ),
+
% Conservative GC implies --no-reclaim-heap-*
( gc_is_conservative(GC_Method) = yes ->
globals.set_option(reclaim_heap_on_semidet_failure, bool(no),
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.144
diff -u -b -r1.144 hlds_module.m
--- compiler/hlds_module.m 3 Nov 2006 08:31:08 -0000 1.144
+++ compiler/hlds_module.m 13 Nov 2006 05:45:24 -0000
@@ -502,6 +502,12 @@
:- pred module_info_get_interface_module_specifiers(module_info::in,
set(module_name)::out) is det.
+:- pred module_info_get_event_spec_map(module_info::in,
+ event_spec_map::out) is det.
+
+:- pred module_info_set_event_spec_map(event_spec_map::in,
+ module_info::in, module_info::out) is det.
+
%-----------------------------------------------------------------------------%
:- pred module_info_preds(module_info::in, pred_table::out) is det.
@@ -767,7 +773,9 @@
% All the directly imported module specifiers in the interface.
% (Used by unused_imports analysis).
- interface_module_specifiers :: set(module_specifier)
+ interface_module_specifiers :: set(module_specifier),
+
+ event_spec_map :: event_spec_map
).
module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
@@ -810,7 +818,7 @@
MM_TablingInfo, map.init, counter.init(1), ImportedModules,
IndirectlyImportedModules, TypeSpecInfo, NoTagTypes, no, [],
init_analysis_info(mmc), [], [],
- map.init, used_modules_init, set.init),
+ map.init, used_modules_init, set.init, map.init),
ModuleInfo = module_info(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, InstanceTable, AssertionTable, ExclusiveTable,
@@ -900,6 +908,7 @@
module_info_get_used_modules(MI, MI ^ sub_info ^ used_modules).
module_info_get_interface_module_specifiers(MI,
MI ^ sub_info ^ interface_module_specifiers).
+module_info_get_event_spec_map(MI, MI ^ sub_info ^ event_spec_map).
% XXX There is some debate as to whether duplicate initialise directives
% in the same module should constitute an error. Currently it is not, but
@@ -1025,6 +1034,8 @@
MI ^ sub_info ^ structure_reuse_map := ReuseMap).
module_info_set_used_modules(UsedModules, MI,
MI ^ sub_info ^ used_modules := UsedModules).
+module_info_set_event_spec_map(EventSpecMap, MI,
+ MI ^ sub_info ^ event_spec_map := EventSpecMap).
module_info_add_parents_to_used_modules(Modules, MI,
MI ^ sub_info ^ used_modules := UsedModules) :-
@@ -1032,7 +1043,6 @@
list.foldl(add_all_modules(visibility_public),
Modules, UsedModules0, UsedModules).
-
%-----------------------------------------------------------------------------%
% Various predicates which do simple things that are nevertheless
Index: compiler/layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout.m,v
retrieving revision 1.29
diff -u -b -r1.29 layout.m
--- compiler/layout.m 29 Sep 2006 06:34:49 -0000 1.29
+++ compiler/layout.m 13 Nov 2006 13:31:19 -0000
@@ -61,7 +61,7 @@
maybe_is_hidden :: maybe(bool),
label_num_in_module :: int,
maybe_goal_path :: maybe(int), % offset
- maybe_solver_info :: maybe(solver_event_data),
+ maybe_user_info :: maybe(user_event_data),
maybe_var_info :: maybe(label_var_info)
)
; proc_layout_data( % defines MR_Proc_Layout
@@ -77,7 +77,8 @@
file_layouts :: list(file_layout_data),
trace_level :: trace_level,
suppressed_events :: int,
- num_label_exec_count :: int
+ num_label_exec_count :: int,
+ maybe_event_specs :: maybe(string)
)
; closure_proc_id_data( % defines MR_Closure_Id
caller_proc_label :: proc_label,
@@ -98,13 +99,14 @@
table_io_decl_type_params :: rval
).
-:- type solver_event_data
- ---> solver_event_data(
- solver_event_name :: string,
- solver_event_num_attr :: int,
- solver_event_locns :: rval,
- solver_event_types :: rval,
- solver_event_names :: list(string)
+:- type user_event_data
+ ---> user_event_data(
+ user_event_number :: int,
+ user_event_name :: string,
+ user_event_num_attr :: int,
+ user_event_locns :: rval,
+ user_event_types :: rval,
+ user_event_names :: list(string)
).
:- type label_var_info
@@ -197,8 +199,8 @@
:- type layout_name
---> label_layout(proc_label, int, label_vars)
- ; solver_event_layout(proc_label, int)
- ; solver_event_attr_names(proc_label, int)
+ ; user_event_layout(proc_label, int)
+ ; user_event_attr_names(proc_label, int)
; proc_layout(rtti_proc_label, proc_layout_kind)
% A proc layout structure for stack tracing, accurate gc,
% deep profiling and/or execution tracing.
@@ -220,6 +222,7 @@
; module_layout_file_vector(module_name)
; module_layout_proc_vector(module_name)
; module_layout_label_exec_count(module_name, int)
+ ; module_layout_event_specs(module_name)
; module_layout(module_name)
; proc_static(rtti_proc_label)
; proc_static_call_sites(rtti_proc_label).
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.76
diff -u -b -r1.76 layout_out.m
--- compiler/layout_out.m 14 Nov 2006 00:22:30 -0000 1.76
+++ compiler/layout_out.m 18 Nov 2006 15:52:30 -0000
@@ -126,10 +126,10 @@
(
Data = label_layout_data(ProcLabel, LabelNum, ProcLayoutAddr,
MaybePort, MaybeIsHidden, LabelNumber, MaybeGoalPath,
- MaybeSolverData, MaybeVarInfo),
+ MaybeUserData, MaybeVarInfo),
output_label_layout_data_defn(ProcLabel, LabelNum, ProcLayoutAddr,
MaybePort, MaybeIsHidden, LabelNumber, MaybeGoalPath,
- MaybeSolverData, MaybeVarInfo, !DeclSet, !IO)
+ MaybeUserData, MaybeVarInfo, !DeclSet, !IO)
;
Data = proc_layout_data(ProcLabel, Traversal, MaybeRest),
output_proc_layout_data_defn(ProcLabel, Traversal, MaybeRest,
@@ -143,10 +143,10 @@
;
Data = module_layout_data(ModuleName, StringTableSize,
StringTable, ProcLayoutNames, FileLayouts, TraceLevel,
- SuppressedEvents, NumLabels),
+ SuppressedEvents, NumLabels, MaybeEventSpecs),
output_module_layout_data_defn(ModuleName, StringTableSize,
StringTable, ProcLayoutNames, FileLayouts, TraceLevel,
- SuppressedEvents, NumLabels, !DeclSet, !IO)
+ SuppressedEvents, NumLabels, MaybeEventSpecs, !DeclSet, !IO)
;
Data = table_io_decl_data(RttiProcLabel, Kind, NumPTIs,
PTIVectorRval, TypeParamsRval),
@@ -196,7 +196,7 @@
_, _, _, _, _),
LayoutName = closure_proc_id(CallerProcLabel, SeqNo, ClosureProcLabel)
;
- Data = module_layout_data(ModuleName, _, _, _, _, _, _, _),
+ Data = module_layout_data(ModuleName, _, _, _, _, _, _, _, _),
LayoutName = module_layout(ModuleName)
;
Data = table_io_decl_data(RttiProcLabel, _, _, _, _),
@@ -237,15 +237,15 @@
io.write_string(
label_to_c_string(internal_label(LabelNum, ProcLabel), yes), !IO)
;
- Data = solver_event_layout(ProcLabel, LabelNum),
+ Data = user_event_layout(ProcLabel, LabelNum),
io.write_string(mercury_data_prefix, !IO),
- io.write_string("_solver_event_layout__", !IO),
+ io.write_string("_user_event_layout__", !IO),
io.write_string(
label_to_c_string(internal_label(LabelNum, ProcLabel), yes), !IO)
;
- Data = solver_event_attr_names(ProcLabel, LabelNum),
+ Data = user_event_attr_names(ProcLabel, LabelNum),
io.write_string(mercury_data_prefix, !IO),
- io.write_string("_solver_event_attr_names__", !IO),
+ io.write_string("_user_event_attr_names__", !IO),
io.write_string(
label_to_c_string(internal_label(LabelNum, ProcLabel), yes), !IO)
;
@@ -337,6 +337,12 @@
ModuleNameStr = sym_name_mangle(ModuleName),
io.write_string(ModuleNameStr, !IO)
;
+ Data = module_layout_event_specs(ModuleName),
+ io.write_string(mercury_data_prefix, !IO),
+ io.write_string("_module_layout_event_specs__", !IO),
+ ModuleNameStr = sym_name_mangle(ModuleName),
+ io.write_string(ModuleNameStr, !IO)
+ ;
Data = module_layout(ModuleName),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_module_layout__", !IO),
@@ -370,13 +376,13 @@
io.write_string(" ", !IO),
output_layout_name(label_layout(ProcLabel, LabelNum, LabelVars), !IO)
;
- Data = solver_event_layout(ProcLabel, LabelNum),
- io.write_string("static const struct MR_Solver_Event_Struct ", !IO),
- output_layout_name(solver_event_layout(ProcLabel, LabelNum), !IO)
+ Data = user_event_layout(ProcLabel, LabelNum),
+ io.write_string("static const struct MR_UserEvent_Struct ", !IO),
+ output_layout_name(user_event_layout(ProcLabel, LabelNum), !IO)
;
- Data = solver_event_attr_names(ProcLabel, LabelNum),
+ Data = user_event_attr_names(ProcLabel, LabelNum),
io.write_string("static const char * ", !IO),
- output_layout_name(solver_event_attr_names(ProcLabel, LabelNum), !IO),
+ output_layout_name(user_event_attr_names(ProcLabel, LabelNum), !IO),
io.write_string("[]", !IO)
;
Data = proc_layout(ProcLabel, Kind),
@@ -473,6 +479,11 @@
output_layout_name(module_layout_proc_vector(ModuleName), !IO),
io.write_string("[]", !IO)
;
+ Data = module_layout_event_specs(ModuleName),
+ io.write_string("static const char ", !IO),
+ output_layout_name(module_layout_event_specs(ModuleName), !IO),
+ io.write_string("[]", !IO)
+ ;
Data = module_layout(ModuleName),
io.write_string("static const MR_Module_Layout ", !IO),
output_layout_name(module_layout(ModuleName), !IO)
@@ -492,8 +503,8 @@
).
layout_name_would_include_code_addr(label_layout(_, _, _)) = no.
-layout_name_would_include_code_addr(solver_event_layout(_, _)) = no.
-layout_name_would_include_code_addr(solver_event_attr_names(_, _)) = no.
+layout_name_would_include_code_addr(user_event_layout(_, _)) = no.
+layout_name_would_include_code_addr(user_event_attr_names(_, _)) = no.
layout_name_would_include_code_addr(proc_layout(_, _)) = no.
layout_name_would_include_code_addr(proc_layout_exec_trace(_)) = yes.
layout_name_would_include_code_addr(proc_layout_head_var_nums(_)) = no.
@@ -508,6 +519,7 @@
layout_name_would_include_code_addr(module_layout_file_vector(_)) = no.
layout_name_would_include_code_addr(module_layout_proc_vector(_)) = no.
layout_name_would_include_code_addr(module_layout_label_exec_count(_, _)) = no.
+layout_name_would_include_code_addr(module_layout_event_specs(_)) = no.
layout_name_would_include_code_addr(module_layout(_)) = no.
layout_name_would_include_code_addr(proc_static(_)) = no.
layout_name_would_include_code_addr(proc_static_call_sites(_)) = no.
@@ -546,44 +558,47 @@
:- pred output_label_layout_data_defn(proc_label::in, int::in, layout_name::in,
maybe(trace_port)::in, maybe(bool)::in, int::in, maybe(int)::in,
- maybe(solver_event_data)::in, maybe(label_var_info)::in,
+ maybe(user_event_data)::in, maybe(label_var_info)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_label_layout_data_defn(ProcLabel, LabelNum, ProcLayoutAddr, MaybePort,
- MaybeIsHidden, LabelNumberInModule, MaybeGoalPath, MaybeSolverData,
+ MaybeIsHidden, LabelNumberInModule, MaybeGoalPath, MaybeUserData,
MaybeVarInfo, !DeclSet, !IO) :-
output_layout_decl(ProcLayoutAddr, !DeclSet, !IO),
(
- MaybeSolverData = no,
- SolverChars = ""
+ MaybeUserData = no,
+ UserChars = ""
;
- MaybeSolverData = yes(SolverData),
- SolverChars = "_S",
- SolverData = solver_event_data(SolverEventName, SolverNumAttributes,
- SolverLocnsRval, SolverTypesRval, SolverAttrNames),
+ MaybeUserData = yes(UserData),
+ UserChars = "_U",
+ UserData = user_event_data(UserEventNumber, UserEventName,
+ UserNumAttributes, UserLocnsRval, UserTypesRval,
+ UserAttrNames),
- AttrNamesLayoutName = solver_event_attr_names(ProcLabel, LabelNum),
+ AttrNamesLayoutName = user_event_attr_names(ProcLabel, LabelNum),
AttrNamesDataAddr = layout_addr(AttrNamesLayoutName),
AttrNamesRval = const(llconst_data_addr(AttrNamesDataAddr, no)),
decl_set_insert(decl_data_addr(AttrNamesDataAddr), !DeclSet),
output_layout_name_storage_type_name(AttrNamesLayoutName, no, !IO),
io.write_string(" = {\n", !IO),
- io.write_list(SolverAttrNames, ", ", io.write, !IO),
+ io.write_list(UserAttrNames, ", ", io.write, !IO),
io.write_string("};\n\n", !IO),
- SolverLayoutName = solver_event_layout(ProcLabel, LabelNum),
- SolverDataAddr = layout_addr(SolverLayoutName),
- decl_set_insert(decl_data_addr(SolverDataAddr), !DeclSet),
- output_layout_name_storage_type_name(SolverLayoutName, no, !IO),
- io.write_string(" = {\n""", !IO),
- io.write_string(SolverEventName, !IO),
+ UserLayoutName = user_event_layout(ProcLabel, LabelNum),
+ UserDataAddr = layout_addr(UserLayoutName),
+ decl_set_insert(decl_data_addr(UserDataAddr), !DeclSet),
+ output_layout_name_storage_type_name(UserLayoutName, no, !IO),
+ io.write_string(" = {\n", !IO),
+ io.write_int(UserEventNumber, !IO),
+ io.write_string(",\n""", !IO),
+ io.write_string(UserEventName, !IO),
io.write_string(""",\n", !IO),
- io.write_int(SolverNumAttributes, !IO),
- io.write_string(",\n", !IO),
- output_rval_as_addr(SolverLocnsRval, !IO),
- io.write_string(",\n", !IO),
- output_rval_as_addr(SolverTypesRval, !IO),
- io.write_string(",\n", !IO),
+ io.write_int(UserNumAttributes, !IO),
+ io.write_string(",\n(MR_Long_Lval *) ", !IO),
+ output_rval_as_addr(UserLocnsRval, !IO),
+ io.write_string(",\n(MR_TypeInfo *) ", !IO),
+ output_rval_as_addr(UserTypesRval, !IO),
+ io.write_string(",\n(const char **)", !IO),
output_rval_as_addr(AttrNamesRval, !IO),
io.write_string("};\n\n", !IO)
),
@@ -649,7 +664,7 @@
Macro0 = "MR_DEF_LLNVI" ++ HiddenChars,
MaybeVarInfoTuple = no
),
- Macro = Macro0 ++ SolverChars,
+ Macro = Macro0 ++ UserChars,
LayoutName = label_layout(ProcLabel, LabelNum, LabelVars),
io.write_string("\n", !IO),
io.write_string(Macro, !IO),
@@ -729,7 +744,7 @@
trace_port_to_string(port_switch) = "SWITCH".
trace_port_to_string(port_nondet_pragma_first) = "PRAGMA_FIRST".
trace_port_to_string(port_nondet_pragma_later) = "PRAGMA_LATER".
-trace_port_to_string(port_solver) = "SOLVER".
+trace_port_to_string(port_user) = "USER".
%-----------------------------------------------------------------------------%
@@ -1280,14 +1295,29 @@
%-----------------------------------------------------------------------------%
+ % The version of the layout data structures -- useful for bootstrapping.
+ % If you write runtime code that checks this version number and can
+ % at least handle the previous version of the data structure,
+ % it makes it easier to bootstrap changes to these data structures.
+ %
+ % This number should be kept in sync with MR_LAYOUT_VERSION in
+ % runtime/mercury_stack_layout.h. This means you need to update
+ % the code in the runtime (including the trace directory) that uses
+ % layout structures to conform to whatever changes the new version
+ % introduces.
+ %
+:- func layout_version_number = int.
+
+layout_version_number = 1.
+
:- pred output_module_layout_data_defn(module_name::in, int::in,
string_with_0s::in, list(layout_name)::in, list(file_layout_data)::in,
- trace_level::in, int::in, int::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ trace_level::in, int::in, int::in, maybe(string)::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_module_layout_data_defn(ModuleName, StringTableSize, StringTable,
ProcLayoutNames, FileLayouts, TraceLevel, SuppressedEvents,
- NumLabels, !DeclSet, !IO) :-
+ NumLabels, MaybeEventSpecs, !DeclSet, !IO) :-
output_module_string_table(ModuleName, StringTableSize, StringTable,
!DeclSet, !IO),
output_module_layout_proc_vector_defn(ModuleName, ProcLayoutNames,
@@ -1304,12 +1334,18 @@
io.write_string(";\n", !IO),
decl_set_insert(decl_data_addr(layout_addr(LabelExecCountName)), !DeclSet),
+ (
+ MaybeEventSpecs = no
+ ;
+ MaybeEventSpecs = yes(EventSpecs),
+ output_event_specs_defn(ModuleName, EventSpecs, !DeclSet, !IO)
+ ),
+
ModuleLayoutName = module_layout(ModuleName),
io.write_string("\n", !IO),
output_layout_name_storage_type_name(ModuleLayoutName, yes, !IO),
io.write_string(" = {\n", !IO),
- VersionNumber = 0,
- io.write_int(VersionNumber, !IO),
+ io.write_int(layout_version_number, !IO),
io.write_string(",\n", !IO),
quote_and_write_string(sym_name_to_string(ModuleName), !IO),
io.write_string(",\n", !IO),
@@ -1335,6 +1371,15 @@
io.write_int(NumLabels, !IO),
io.write_string(",\n", !IO),
output_layout_name(LabelExecCountName, !IO),
+ io.write_string(",\n", !IO),
+ (
+ MaybeEventSpecs = no,
+ io.write_string("NULL", !IO)
+ ;
+ MaybeEventSpecs = yes(_),
+ EventSpecLayoutName = module_layout_event_specs(ModuleName),
+ output_layout_name(EventSpecLayoutName, !IO)
+ ),
io.write_string("\n};\n", !IO),
decl_set_insert(decl_data_addr(layout_addr(ModuleLayoutName)), !DeclSet).
@@ -1377,6 +1422,20 @@
%-----------------------------------------------------------------------------%
+:- pred output_event_specs_defn(module_name::in, string::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
+
+output_event_specs_defn(ModuleName, EventSpecs, !DeclSet, !IO) :-
+ LayoutName = module_layout_event_specs(ModuleName),
+ io.write_string("\n", !IO),
+ output_layout_name_storage_type_name(LayoutName, yes, !IO),
+ io.write_string(" = {", !IO),
+ string.length(EventSpecs, EventSpecsSize),
+ output_module_string_table_chars_driver(0, EventSpecsSize - 1,
+ string_with_0s(EventSpecs), !IO),
+ io.write_string("};\n", !IO),
+ decl_set_insert(decl_data_addr(layout_addr(LayoutName)), !DeclSet).
+
% The string table cannot be zero size; it must contain at least an
% empty string.
%
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.296
diff -u -b -r1.296 llds_out.m
--- compiler/llds_out.m 1 Nov 2006 02:31:07 -0000 1.296
+++ compiler/llds_out.m 13 Nov 2006 12:24:43 -0000
@@ -634,7 +634,7 @@
output_debugger_init_list_decls([], !DeclSet, !IO).
output_debugger_init_list_decls([Data | Datas], !DeclSet, !IO) :-
- ( Data = module_layout_data(ModuleName, _, _, _, _, _, _, _) ->
+ ( Data = module_layout_data(ModuleName, _, _, _, _, _, _, _, _) ->
output_data_addr_decls(layout_addr(module_layout(ModuleName)),
!DeclSet, !IO)
;
@@ -651,7 +651,7 @@
output_debugger_init_list([], !IO).
output_debugger_init_list([Data | Datas], !IO) :-
- ( Data = module_layout_data(ModuleName, _, _, _, _, _, _, _) ->
+ ( Data = module_layout_data(ModuleName, _, _, _, _, _, _, _, _) ->
io.write_string("\tif (MR_register_module_layout != NULL) {\n", !IO),
io.write_string("\t\t(*MR_register_module_layout)(", !IO),
io.write_string("\n\t\t\t&", !IO),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.414
diff -u -b -r1.414 mercury_compile.m
--- compiler/mercury_compile.m 3 Nov 2006 08:31:09 -0000 1.414
+++ compiler/mercury_compile.m 17 Nov 2006 03:31:11 -0000
@@ -48,6 +48,7 @@
:- import_module parse_tree.prog_out.
:- import_module parse_tree.modules.
:- import_module parse_tree.source_file_map.
+:- import_module parse_tree.prog_event.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.equiv_type.
:- import_module hlds.make_hlds.
@@ -1710,15 +1711,15 @@
globals.lookup_bool_option(Globals, statistics, Stats),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, invoked_by_mmc_make, MMCMake),
- DontWriteDFile1 = DontWriteDFile0 `or` MMCMake,
+ DontWriteDFile1 = bool.or(DontWriteDFile0, MMCMake),
% Don't write the `.d' file when making the `.opt' file because
% we can't work out the full transitive implementation dependencies.
globals.lookup_bool_option(Globals, make_optimization_interface,
MakeOptInt),
- DontWriteDFile = DontWriteDFile1 `or` MakeOptInt,
+ DontWriteDFile = bool.or(DontWriteDFile1, MakeOptInt),
- module_imports_get_module_name(ModuleImports0, Module),
+ module_imports_get_module_name(ModuleImports0, ModuleName),
(
DontWriteDFile = yes,
% The only time the TransOptDeps are required is when
@@ -1728,22 +1729,46 @@
MaybeTransOptDeps = no
;
DontWriteDFile = no,
- maybe_read_dependency_file(Module, MaybeTransOptDeps, !IO)
+ maybe_read_dependency_file(ModuleName, MaybeTransOptDeps, !IO)
),
% Errors in .opt and .trans_opt files result in software errors.
maybe_grab_optfiles(ModuleImports0, Verbose, MaybeTransOptDeps,
ModuleImports1, IntermodError, !IO),
+ globals.lookup_string_option(Globals, event_spec_file_name,
+ EventSpecFileName),
+ ( EventSpecFileName = "" ->
+ EventSpecMap1 = map.init,
+ EventSpecErrors = no
+ ;
+ read_event_specs(EventSpecFileName, EventSpecMap0, EventSpecErrorSpecs,
+ !IO),
+ (
+ EventSpecErrorSpecs = [],
+ EventSpecMap1 = EventSpecMap0,
+ EventSpecErrors = no
+ ;
+ EventSpecErrorSpecs = [_ | _],
+ EventSpecMap1 = map.init,
+ EventSpecErrors = yes,
+ % XXX _NumErrors
+ write_error_specs(EventSpecErrorSpecs, Globals,
+ 0, _EventSpecNumWarnings, 0, _EventSpecNumErrors, !IO)
+ )
+ ),
+
module_imports_get_items(ModuleImports1, Items1),
MaybeTimestamps = ModuleImports1 ^ maybe_timestamps,
- invoke_module_qualify_items(Items1, Items2, Module, Verbose, Stats,
- MQInfo0, UndefTypes0, UndefModes0, !IO),
+ invoke_module_qualify_items(Items1, Items2, EventSpecMap1, EventSpecMap2,
+ ModuleName, EventSpecFileName, Verbose, Stats, MQInfo0,
+ MQUndefTypes, MQUndefModes, !IO),
mq_info_get_recompilation_info(MQInfo0, RecompInfo0),
- expand_equiv_types(Module, Verbose, Stats, Items2, Items,
- EqvMap, UsedModules, RecompInfo0, RecompInfo, ExpandSpecs, !IO),
+ expand_equiv_types(ModuleName, Verbose, Stats, Items2, Items,
+ EventSpecMap2, EventSpecMap, EqvMap, UsedModules,
+ RecompInfo0, RecompInfo, ExpandSpecs, !IO),
mq_info_set_recompilation_info(RecompInfo, MQInfo0, MQInfo),
(
ExpandSpecs = [],
@@ -1752,17 +1777,17 @@
ExpandSpecs = [_ | _],
CircularTypes = yes,
% XXX _NumErrors
- write_error_specs(ExpandSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
- !IO)
+ write_error_specs(ExpandSpecs, Globals,
+ 0, _ExpandNumWarnings, 0, _ExpandNumErrors, !IO)
),
- bool.or(UndefTypes0, CircularTypes, UndefTypes1),
- make_hlds(Module, Items, MQInfo, EqvMap, UsedModules,
+ make_hlds(ModuleName, Items, EventSpecMap, MQInfo, EqvMap, UsedModules,
Verbose, Stats, HLDS0, QualInfo,
- UndefTypes2, UndefModes2, FoundError, !IO),
+ MakeHLDSUndefTypes, MakeHLDSUndefModes, FoundError, !IO),
- bool.or(UndefTypes1, UndefTypes2, UndefTypes),
- bool.or(UndefModes0, UndefModes2, UndefModes),
+ bool.or_list([MQUndefTypes, EventSpecErrors, CircularTypes,
+ MakeHLDSUndefTypes], UndefTypes),
+ bool.or(MQUndefModes, MakeHLDSUndefModes, UndefModes),
maybe_dump_hlds(HLDS0, 1, "initial", !DumpInfo, !IO),
@@ -1794,17 +1819,20 @@
).
:- pred invoke_module_qualify_items(item_list::in, item_list::out,
- module_name::in, bool::in, bool::in, mq_info::out,
+ event_spec_map::in, event_spec_map::out,
+ module_name::in, string::in, bool::in, bool::in, mq_info::out,
bool::out, bool::out, io::di, io::uo) is det.
-invoke_module_qualify_items(Items0, Items, ModuleName, Verbose, Stats, MQInfo,
+invoke_module_qualify_items(Items0, Items, EventSpecMap0, EventSpecMap,
+ ModuleName, EventSpecFileName, Verbose, Stats, MQInfo,
UndefTypes, UndefModes, !IO) :-
maybe_write_string(Verbose, "% Module qualifying items...\n", !IO),
maybe_flush_output(Verbose, !IO),
globals.io_get_globals(Globals, !IO),
module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
- module_qualify_items(Items0, Items, Globals, ModuleName, yes(FileName),
- MQInfo, UndefTypes, UndefModes, [], Specs),
+ module_qualify_items(Items0, Items, EventSpecMap0, EventSpecMap,
+ Globals, ModuleName, yes(FileName), EventSpecFileName, MQInfo,
+ UndefTypes, UndefModes, [], Specs),
write_error_specs(Specs, Globals, 0, _NumWarnings, 0, _NumErrors, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO).
@@ -1892,32 +1920,36 @@
bool.or(Error1, Error2, Error).
:- pred expand_equiv_types(module_name::in, bool::in, bool::in,
- item_list::in, item_list::out, eqv_map::out, used_modules::out,
+ item_list::in, item_list::out, event_spec_map::in, event_spec_map::out,
+ eqv_map::out, used_modules::out,
maybe(recompilation_info)::in, maybe(recompilation_info)::out,
list(error_spec)::out, io::di, io::uo) is det.
expand_equiv_types(ModuleName, Verbose, Stats, Items0, Items,
- EqvMap, UsedModules, RecompInfo0, RecompInfo, Specs, !IO) :-
+ EventSpecMap0, EventSpecMap, EqvMap, UsedModules,
+ RecompInfo0, RecompInfo, Specs, !IO) :-
maybe_write_string(Verbose, "% Expanding equivalence types...", !IO),
maybe_flush_output(Verbose, !IO),
equiv_type.expand_eqv_types(ModuleName, Items0, Items,
- EqvMap, UsedModules, RecompInfo0, RecompInfo, Specs),
+ EventSpecMap0, EventSpecMap, EqvMap, UsedModules,
+ RecompInfo0, RecompInfo, Specs),
maybe_write_string(Verbose, " done.\n", !IO),
maybe_report_stats(Stats, !IO).
-:- pred make_hlds(module_name::in, item_list::in, mq_info::in,
- eqv_map::in, used_modules::in, bool::in, bool::in, module_info::out,
- make_hlds_qual_info::out, bool::out, bool::out, bool::out, io::di, io::uo)
- is det.
+:- pred make_hlds(module_name::in, item_list::in, event_spec_map::in,
+ mq_info::in, eqv_map::in, used_modules::in, bool::in, bool::in,
+ module_info::out, make_hlds_qual_info::out,
+ bool::out, bool::out, bool::out, io::di, io::uo) is det.
-make_hlds(Module, Items, MQInfo, EqvMap, UsedModules,
- Verbose, Stats, HLDS, QualInfo,
+make_hlds(Module, Items, EventSpecMap, MQInfo, EqvMap, UsedModules,
+ Verbose, Stats, !:HLDS, QualInfo,
UndefTypes, UndefModes, FoundSemanticError, !IO) :-
maybe_write_string(Verbose, "% Converting parse tree to hlds...\n", !IO),
Prog = unit_module(Module, Items),
- parse_tree_to_hlds(Prog, MQInfo, EqvMap, UsedModules, HLDS, QualInfo,
+ parse_tree_to_hlds(Prog, MQInfo, EqvMap, UsedModules, !:HLDS, QualInfo,
UndefTypes, UndefModes, !IO),
- module_info_get_num_errors(HLDS, NumErrors),
+ module_info_set_event_spec_map(EventSpecMap, !HLDS),
+ module_info_get_num_errors(!.HLDS, NumErrors),
io.get_exit_status(Status, !IO),
(
( Status \= 0
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.349
diff -u -b -r1.349 modes.m
--- compiler/modes.m 6 Nov 2006 07:55:11 -0000 1.349
+++ compiler/modes.m 13 Nov 2006 13:49:21 -0000
@@ -1521,7 +1521,9 @@
unexpected(this_file, "modecheck_goal_expr: class_method_call")
;
GenericCall = event_call(EventName),
- ( event_arg_modes(EventName, ModesPrime) ->
+ mode_info_get_module_info(!.ModeInfo, ModuleInfo),
+ module_info_get_event_spec_map(ModuleInfo, EventSpecMap),
+ ( event_arg_modes(EventSpecMap, EventName, ModesPrime) ->
Modes = ModesPrime
;
% The typechecker should have caught the unknown event,
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.151
diff -u -b -r1.151 module_qual.m
--- compiler/module_qual.m 1 Nov 2006 06:33:00 -0000 1.151
+++ compiler/module_qual.m 13 Nov 2006 14:53:36 -0000
@@ -37,17 +37,23 @@
%-----------------------------------------------------------------------------%
- % module_qualify_items(Items0, Items, Globals, ModuleName,
- % MaybeFileName, MQ_Info, UndefTypes, UndefModes, !Specs, !IO):
+ % module_qualify_items(Items0, Items, EventSpecMap0, EventSpecMap,
+ % Globals, ModuleName, MaybeFileName, EventSpecFileName, MQ_Info,
+ % UndefTypes, UndefModes, !Specs, !IO):
+ %
+ % Items is Items0 with all items module qualified as much as possible;
+ % likewise for EventSpecMap0 and EventSpecMap.
%
- % Items is Items0 with all items module qualified as much as possible.
% If MaybeFileName is `yes(FileName)', then report undefined types, insts
- % and modes. MaybeFileName should be `no' when module qualifying the short
- % interface.
+ % and modes in Items0. MaybeFileName should be `no' when module qualifying
+ % the short interface.
%
-:- pred module_qualify_items(item_list::in, item_list::out, globals::in,
- module_name::in, maybe(string)::in, mq_info::out, bool::out, bool::out,
- list(error_spec)::in, list(error_spec)::out) is det.
+ % Errors in EventSpecMap0 will be reported as being for EventSpecFileName.
+ %
+:- pred module_qualify_items(item_list::in, item_list::out,
+ event_spec_map::in, event_spec_map::out, globals::in,
+ module_name::in, maybe(string)::in, string::in, mq_info::out,
+ bool::out, bool::out, list(error_spec)::in, list(error_spec)::out) is det.
% This is called from make_hlds to qualify the mode of a lambda expression.
%
@@ -144,8 +150,9 @@
%-----------------------------------------------------------------------------%
-module_qualify_items(Items0, Items, Globals, ModuleName, MaybeFileName, Info,
- UndefTypes, UndefModes, !Specs) :-
+module_qualify_items(Items0, Items, EventSpecMap0, EventSpecMap, Globals,
+ ModuleName, MaybeFileName, EventSpecFileName, !:Info, UndefTypes,
+ UndefModes, !Specs) :-
(
MaybeFileName = yes(_),
ReportErrors = yes
@@ -153,14 +160,18 @@
MaybeFileName = no,
ReportErrors = no
),
- init_mq_info(Items0, Globals, ReportErrors, ModuleName, Info0),
- collect_mq_info(Items0, Info0, Info1),
- do_module_qualify_items(Items0, Items, Info1, Info, !Specs),
- mq_info_get_type_error_flag(Info, UndefTypes),
- mq_info_get_mode_error_flag(Info, UndefModes),
+ init_mq_info(Items0, Globals, ReportErrors, ModuleName, !:Info),
+ collect_mq_info(Items0, !Info),
+ do_module_qualify_items(Items0, Items, !Info, !Specs),
+ map.to_assoc_list(EventSpecMap0, EventSpecList0),
+ do_module_qualify_event_specs(EventSpecFileName,
+ EventSpecList0, EventSpecList, !Info, !Specs),
+ map.from_assoc_list(EventSpecList, EventSpecMap),
+ mq_info_get_type_error_flag(!.Info, UndefTypes),
+ mq_info_get_mode_error_flag(!.Info, UndefModes),
(
MaybeFileName = yes(FileName),
- mq_info_get_unused_interface_modules(Info, UnusedImports0),
+ mq_info_get_unused_interface_modules(!.Info, UnusedImports0),
set.to_sorted_list(UnusedImports0, UnusedImports),
maybe_warn_unused_interface_imports(ModuleName, FileName,
UnusedImports, !Specs)
@@ -200,7 +211,6 @@
modes :: mode_id_set,
classes :: class_id_set,
-
% Modules imported in the interface that are not definitely
% needed in the interface.
unused_interface_modules :: set(module_name),
@@ -223,7 +233,7 @@
% The context of the current item.
error_context :: error_context,
- % The name of the current module
+ % The name of the current module.
this_module :: module_name,
% Must uses of the current item be explicitly module qualified.
@@ -257,8 +267,8 @@
collect_mq_info([], !Info).
collect_mq_info([Item - _ | Items], !Info) :-
( Item = item_module_defn(_, md_transitively_imported) ->
- % Don't process the transitively imported items (from `.int2'
- % files). They can't be used in the current module.
+ % Don't process the transitively imported items (from `.int2' files).
+ % They can't be used in the current module.
true
;
collect_mq_info_2(Item, !Info),
@@ -269,8 +279,8 @@
collect_mq_info_2(item_clause(_, _, _, _, _, _), !Info).
collect_mq_info_2(item_type_defn(_, SymName, Params, _, _), !Info) :-
- % This item is not visible in the current module.
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
+ % This item is not visible in the current module.
true
;
list.length(Params, Arity),
@@ -284,8 +294,8 @@
mq_info_set_impl_types(ImplTypes, !Info)
).
collect_mq_info_2(item_inst_defn(_, SymName, Params, _, _), !Info) :-
- % This item is not visible in the current module.
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
+ % This item is not visible in the current module.
true
;
list.length(Params, Arity),
@@ -295,8 +305,8 @@
mq_info_set_insts(Insts, !Info)
).
collect_mq_info_2(item_mode_defn(_, SymName, Params, _, _), !Info) :-
- % This item is not visible in the current module.
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
+ % This item is not visible in the current module.
true
;
list.length(Params, Arity),
@@ -327,8 +337,8 @@
).
collect_mq_info_2(item_nothing(_), !Info).
collect_mq_info_2(item_typeclass(_, _, SymName, Params, _, _), !Info) :-
- % This item is not visible in the current module.
( mq_info_get_import_status(!.Info, mq_status_abstract_imported) ->
+ % This item is not visible in the current module.
true
;
list.length(Params, Arity),
@@ -724,10 +734,10 @@
).
module_qualify_item(
- item_instance(Constraints0, Name0, Types0, Body0, VarSet,
- ModName) - Context,
- item_instance(Constraints, Name, Types, Body, VarSet,
- ModName) - Context,
+ item_instance(Constraints0, Name0, Types0, Body0, VarSet, ModName)
+ - Context,
+ item_instance(Constraints, Name, Types, Body, VarSet, ModName)
+ - Context,
!Info, yes, !Specs) :-
list.length(Types0, Arity),
Id = mq_id(Name0, Arity),
@@ -758,6 +768,50 @@
qualify_type(Type0, Type, !Info, !Specs),
qualify_inst(Inst0, Inst, !Info, !Specs).
+:- pred do_module_qualify_event_specs(string::in,
+ assoc_list(string, event_spec)::in, assoc_list(string, event_spec)::out,
+ mq_info::in, mq_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+do_module_qualify_event_specs(_, [], [], !Info, !Specs).
+do_module_qualify_event_specs(FileName,
+ [Name - Spec0 | NameSpecs0], [Name - Spec | NameSpecs],
+ !Info, !Specs) :-
+ do_module_qualify_event_spec(FileName, Name, Spec0, Spec, !Info, !Specs),
+ do_module_qualify_event_specs(FileName, NameSpecs0, NameSpecs,
+ !Info, !Specs).
+
+:- pred do_module_qualify_event_spec(string::in, string::in,
+ event_spec::in, event_spec::out, mq_info::in, mq_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+do_module_qualify_event_spec(EventName, FileName, EventSpec0, EventSpec,
+ !Info, !Specs) :-
+ EventSpec0 = event_spec(EventNumber, EventLineNumber,
+ VisAttrs0, AllAttrs0),
+ list.map_foldl2(
+ do_module_qualify_event_attr(EventName, FileName, EventLineNumber),
+ VisAttrs0, VisAttrs, !Info, !Specs),
+ list.map_foldl2(
+ do_module_qualify_event_attr(EventName, FileName, EventLineNumber),
+ AllAttrs0, AllAttrs, !Info, !Specs),
+ EventSpec = event_spec(EventNumber, EventLineNumber,
+ VisAttrs, AllAttrs).
+
+:- pred do_module_qualify_event_attr(string::in, string::in, int::in,
+ event_attribute::in, event_attribute::out, mq_info::in, mq_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+do_module_qualify_event_attr(EventName, FileName, LineNumber, Attr0, Attr,
+ !Info, !Specs) :-
+ Attr0 = event_attribute(AttrName, AttrType0, AttrMode0, MaybeSynthCall),
+ MQErrorContext = mqec_event_spec_attr(EventName, AttrName),
+ Context = context(FileName, LineNumber),
+ mq_info_set_error_context(MQErrorContext - Context, !Info),
+ qualify_type(AttrType0, AttrType, !Info, !Specs),
+ qualify_mode(AttrMode0, AttrMode, !Info, !Specs),
+ Attr = event_attribute(AttrName, AttrType, AttrMode, MaybeSynthCall).
+
:- pred update_import_status(module_defn::in, mq_info::in, mq_info::out,
bool::out) is det.
@@ -1433,7 +1487,8 @@
; mqec_type_qual
; mqec_class(mq_id)
; mqec_instance(mq_id)
- ; mqec_mutable(string).
+ ; mqec_mutable(string)
+ ; mqec_event_spec_attr(string, string). % event name, attr name
:- func id_to_sym_name_and_arity(mq_id) = sym_name_and_arity.
@@ -1556,6 +1611,8 @@
words(Name),
suffix("'")
].
+mq_error_context_to_pieces(mqec_event_spec_attr(EventName, AttrName)) =
+ [words("attribute"), quote(AttrName), words("for"), quote(EventName)].
:- pred id_type_to_string(id_type::in, string::out) is det.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.409
diff -u -b -r1.409 modules.m
--- compiler/modules.m 7 Nov 2006 01:59:03 -0000 1.409
+++ compiler/modules.m 13 Nov 2006 06:22:14 -0000
@@ -1262,8 +1262,8 @@
module_imports_get_items(Module, Items1),
globals.io_get_globals(Globals, !IO),
module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
- module_qualify_items(Items1, Items2, Globals, ModuleName,
- yes(FileName), _, _, _, [], Specs),
+ module_qualify_items(Items1, Items2, map.init, _, Globals, ModuleName,
+ yes(FileName), "", _, _, _, [], Specs),
(
Specs = [_ | _],
sort_error_specs(Specs, SortedSpecs),
@@ -1382,8 +1382,8 @@
% Module-qualify all items.
globals.io_get_globals(Globals, !IO),
module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
- module_qualify_items(!InterfaceItems, Globals, ModuleName,
- yes(FileName), _, _, _, [], Specs),
+ module_qualify_items(!InterfaceItems, map.init, _, Globals,
+ ModuleName, yes(FileName), "", _, _, _, [], Specs),
% We want to finish writing the interface file (and keep
% the exit status at zero) if we found some warnings.
@@ -1431,7 +1431,7 @@
get_short_interface(InterfaceItems, int3, ShortInterfaceItems0),
globals.io_get_globals(Globals, !IO),
module_qualify_items(ShortInterfaceItems0, ShortInterfaceItems,
- Globals, ModuleName, no, _, _, _, [], Specs),
+ map.init, _, Globals, ModuleName, no, "", _, _, _, [], Specs),
sort_error_specs(Specs, SortedSpecs),
write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
!IO),
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.180
diff -u -b -r1.180 opt_debug.m
--- compiler/opt_debug.m 1 Nov 2006 02:31:08 -0000 1.180
+++ compiler/opt_debug.m 13 Nov 2006 13:32:08 -0000
@@ -459,12 +459,12 @@
LabelVarsStr = "label_has_no_var_info"
),
Str = "label_layout(" ++ LabelStr ++ ", " ++ LabelVarsStr ++ ")".
-dump_layout_name(solver_event_layout(ProcLabel, LabelNum)) = Str :-
+dump_layout_name(user_event_layout(ProcLabel, LabelNum)) = Str :-
LabelStr = dump_label(internal_label(LabelNum, ProcLabel)),
- Str = "solver_event_layout(" ++ LabelStr ++ ")".
-dump_layout_name(solver_event_attr_names(ProcLabel, LabelNum)) = Str :-
+ Str = "user_event_layout(" ++ LabelStr ++ ")".
+dump_layout_name(user_event_attr_names(ProcLabel, LabelNum)) = Str :-
LabelStr = dump_label(internal_label(LabelNum, ProcLabel)),
- Str = "solver_event_attr_names(" ++ LabelStr ++ ")".
+ Str = "user_event_attr_names(" ++ LabelStr ++ ")".
dump_layout_name(proc_layout(RttiProcLabel, _)) =
"proc_layout(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
dump_layout_name(proc_layout_exec_trace(RttiProcLabel)) =
@@ -496,6 +496,8 @@
dump_layout_name(module_layout_label_exec_count(ModuleName, NumLabels)) =
"module_layout_label_exec_count(" ++ sym_name_mangle(ModuleName)
++ ", " ++ int_to_string(NumLabels) ++ ")".
+dump_layout_name(module_layout_event_specs(ModuleName)) =
+ "module_layout_event_specs(" ++ sym_name_mangle(ModuleName) ++ ")".
dump_layout_name(module_layout(ModuleName)) =
"module_layout(" ++ sym_name_mangle(ModuleName) ++ ")".
dump_layout_name(proc_static(RttiProcLabel)) =
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.536
diff -u -b -r1.536 options.m
--- compiler/options.m 3 Nov 2006 08:31:10 -0000 1.536
+++ compiler/options.m 13 Nov 2006 05:29:45 -0000
@@ -241,6 +241,7 @@
; infer_all
; type_inference_iteration_limit
; mode_inference_iteration_limit
+ ; event_spec_file_name
% Compilation Model options
; grade
@@ -1006,7 +1007,8 @@
infer_det - bool(yes),
infer_all - bool_special,
type_inference_iteration_limit - int(60),
- mode_inference_iteration_limit - int(30)
+ mode_inference_iteration_limit - int(30),
+ event_spec_file_name - string("")
]).
option_defaults_2(compilation_model_option, [
% Compilation model options (ones that affect binary compatibility).
@@ -1744,6 +1746,7 @@
long_option("infer-det", infer_det).
long_option("type-inference-iteration-limit", type_inference_iteration_limit).
long_option("mode-inference-iteration-limit", mode_inference_iteration_limit).
+long_option("event-spec-file-name", event_spec_file_name).
% compilation model options
long_option("grade", grade).
@@ -3308,7 +3311,9 @@
"--type-inference-iteration-limit <n>",
"\tPerform at most <n> passes of type inference (default: 60).",
"--mode-inference-iteration-limit <n>",
- "\tPerform at most <n> passes of mode inference (default: 30)."
+ "\tPerform at most <n> passes of mode inference (default: 30).",
+ "--event-spec-file-name <filename>",
+ "\tGet the specification of user-defined events from <filename>."
]).
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.85
diff -u -b -r1.85 passes_aux.m
--- compiler/passes_aux.m 15 Oct 2006 23:26:48 -0000 1.85
+++ compiler/passes_aux.m 18 Nov 2006 15:48:10 -0000
@@ -192,13 +192,14 @@
:- pred invoke_system_command(io.output_stream::in,
command_verbosity::in, string::in, bool::out, io::di, io::uo) is det.
- % invoke_system_command(ErrorStream, Verbosity, Command,
- % ProcessOutput, Succeeded)
+ % invoke_system_command_maybe_filter_output(ErrorStream, Verbosity,
+ % Command, MaybeProcessOutput, Succeeded)
%
% Invoke an executable. Both standard and error output will go to the
- % specified output stream after being piped through `ProcessOutput'.
+ % specified output stream after being piped through `ProcessOutput'
+ % if MaybeProcessOutput is yes(ProcessOutput).
%
-:- pred invoke_system_command(io.output_stream::in,
+:- pred invoke_system_command_maybe_filter_output(io.output_stream::in,
command_verbosity::in, string::in, maybe(string)::in, bool::out,
io::di, io::uo) is det.
@@ -426,9 +427,10 @@
maybe_set_exit_status(no, !IO) :- io.set_exit_status(1, !IO).
invoke_system_command(ErrorStream, Verbosity, Command, Succeeded, !IO) :-
- invoke_system_command(ErrorStream, Verbosity, Command, no, Succeeded, !IO).
+ invoke_system_command_maybe_filter_output(ErrorStream, Verbosity, Command,
+ no, Succeeded, !IO).
-invoke_system_command(ErrorStream, Verbosity, Command,
+invoke_system_command_maybe_filter_output(ErrorStream, Verbosity, Command,
MaybeProcessOutput, Succeeded, !IO) :-
% This predicate shouldn't alter the exit status of mercury_compile.
io.get_exit_status(OldStatus, !IO),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.178
diff -u -b -r1.178 prog_data.m
--- compiler/prog_data.m 1 Nov 2006 06:33:06 -0000 1.178
+++ compiler/prog_data.m 13 Nov 2006 15:16:52 -0000
@@ -144,19 +144,6 @@
:- pred det_switch_canfail(can_fail::in, can_fail::in, can_fail::out) is det.
- % The `is_solver_type' type specifies whether a type is a "solver" type,
- % for which `any' insts are interpreted as "don't know", or a non-solver
- % type for which `any' is the same as `bound(...)'.
- %
-:- type is_solver_type
- ---> non_solver_type
- % The inst `any' is always `bound' for this type.
-
- ; solver_type.
- % The inst `any' is not always `bound' for this type
- % (i.e. the type was declared with
- % `:- solver type ...').
-
%-----------------------------------------------------------------------------%
%
% Stuff for the foreign language interface pragmas
@@ -1046,6 +1033,19 @@
foreign_assertions :: list(foreign_type_assertion)
).
+ % The `is_solver_type' type specifies whether a type is a "solver" type,
+ % for which `any' insts are interpreted as "don't know", or a non-solver
+ % type for which `any' is the same as `bound(...)'.
+ %
+:- type is_solver_type
+ ---> non_solver_type
+ % The inst `any' is always `bound' for this type.
+
+ ; solver_type.
+ % The inst `any' is not always `bound' for this type
+ % (i.e. the type was declared with
+ % `:- solver type ...').
+
:- type foreign_type_assertion
---> foreign_type_can_pass_as_mercury_type
; foreign_type_stable.
@@ -1523,7 +1523,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-
:- type item_visibility
---> visibility_public
; visibility_private.
@@ -1554,6 +1553,35 @@
used_modules::in, used_modules::out) is det.
%-----------------------------------------------------------------------------%
+%
+% Event specifications
+%
+
+:- type event_attribute
+ ---> event_attribute(
+ attr_name :: string,
+ attr_type :: mer_type,
+ attr_mode :: mer_mode,
+ attr_maybe_synth_call :: maybe(event_attr_synth_call)
+ ).
+
+:- type event_attr_synth_call
+ ---> event_attr_synth_call(
+ synth_func_attr_name :: string,
+ synth_arg_attr_names :: list(string)
+ ).
+
+:- type event_spec
+ ---> event_spec(
+ event_spec_num :: int,
+ event_spec_linenum :: int,
+ event_spec_visible_attrs :: list(event_attribute),
+ event_spec_all_attrs :: list(event_attribute)
+ ).
+
+ % This type maps the name of an event to the event's specification.
+:- type event_spec_map == map(string, event_spec).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/prog_event.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_event.m,v
retrieving revision 1.2
diff -u -b -r1.2 prog_event.m
--- compiler/prog_event.m 29 Sep 2006 06:34:50 -0000 1.2
+++ compiler/prog_event.m 19 Nov 2006 14:56:35 -0000
@@ -17,53 +17,597 @@
:- module parse_tree.prog_event.
:- interface.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
+:- import_module io.
:- import_module list.
-:- type event_attribute
- ---> event_attribute(
- attr_name :: string,
- attr_type :: mer_type,
- attr_mode :: mer_mode
- ).
+ % read_event_specs(FileName, EventSpecMap, ErrorSpecs, !IO):
+ %
+ % Read in a set of event specifications from FileName, and return them
+ % in EventSpecMap. Set ErrorSpecs to a list of all the errors discovered
+ % during the process.
+ %
+:- pred read_event_specs(string::in, event_spec_map::out,
+ list(error_spec)::out, io::di, io::uo) is det.
- % Given an event name, returns the types and modes of the arguments
- % of the event.
+ % Return a description of the given event set.
%
-:- pred event_args(string::in, list(event_attribute)::out) is semidet.
+:- func event_set_description(event_spec_map) = string.
+
+ % Given an event name, returns its number.
+ %
+:- pred event_number(event_spec_map::in, string::in, int::out) is semidet.
% Given an event name, returns the names of the arguments of the event.
%
-:- pred event_arg_names(string::in, list(string)::out) is semidet.
+:- pred event_arg_names(event_spec_map::in, string::in, list(string)::out)
+ is semidet.
% Given an event name, returns the types of the arguments of the event.
%
-:- pred event_arg_types(string::in, list(mer_type)::out) is semidet.
+:- pred event_arg_types(event_spec_map::in, string::in, list(mer_type)::out)
+ is semidet.
% Given an event name, returns the modes of the arguments of the event.
%
-:- pred event_arg_modes(string::in, list(mer_mode)::out) is semidet.
+:- pred event_arg_modes(event_spec_map::in, string::in, list(mer_mode)::out)
+ is semidet.
+
+%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module libs.compiler_util.
+:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_mode.
+:- import_module parse_tree.prog_out.
+:- import_module bimap.
+:- import_module bool.
+:- import_module maybe.
:- import_module pair.
+:- import_module map.
+:- import_module relation.
+:- import_module string.
+:- import_module svbimap.
+:- import_module svmap.
+:- import_module svrelation.
+:- import_module term.
+
+read_event_specs(SpecsFileName, EventSpecMap, ErrorSpecs, !IO) :-
+ % Currently, we convert the event specification file into a Mercury term
+ % by using the yacc parser in the trace directory to create a C data
+ % structure to represent its contents, writing out that data structure
+ % as a Mercury term to a file (TermFileName), and then reading in the term
+ % from that file.
+ %
+ % This is clumsy approach, since it requires access to the C code in the
+ % trace directory (via the event_spec library) and a temporary file.
+ % Using Mercury scanners and parsers generated by mscangen and mparsegen
+ % respectively would be a much better and more direct approach, but
+ % those tools are not yet mature enough. When they are, we should switch
+ % to using them.
+
+ io.make_temp(TermFileName, !IO),
+ read_specs_file(SpecsFileName, TermFileName, Problem, !IO),
+ ( Problem = "" ->
+ io.open_input(TermFileName, TermOpenRes, !IO),
+ (
+ TermOpenRes = ok(TermStream),
+ io.read(TermStream, TermReadRes, !IO),
+ (
+ TermReadRes = ok(EventSpecsTerm),
+ convert_list_to_spec_map(TermFileName, EventSpecsTerm,
+ map.init, EventSpecMap, [], ErrorSpecs)
+ ;
+ TermReadRes = eof,
+ EventSpecMap = map.init,
+ Pieces = [words("eof in term specification file"), nl],
+ ErrorSpec = error_spec(severity_error,
+ phase_term_to_parse_tree,
+ [error_msg(no, no, 0, [always(Pieces)])]),
+ ErrorSpecs = [ErrorSpec]
+ ;
+ TermReadRes = error(TermReadMsg, LineNumber),
+ EventSpecMap = map.init,
+ Pieces = [words(TermReadMsg), nl],
+ ErrorSpec = error_spec(severity_error,
+ phase_term_to_parse_tree,
+ [simple_msg(context(TermFileName, LineNumber),
+ [always(Pieces)])]),
+ ErrorSpecs = [ErrorSpec]
+ ),
+ io.close_input(TermStream, !IO)
+ ;
+ TermOpenRes = error(TermOpenError),
+ EventSpecMap = map.init,
+ Pieces = [words(io.error_message(TermOpenError)), nl],
+ ErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [error_msg(no, no, 0, [always(Pieces)])]),
+ ErrorSpecs = [ErrorSpec]
+ )
+ ;
+ EventSpecMap = map.init,
+ Pieces = [words(Problem), nl],
+ ErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [error_msg(no, no, 0, [always(Pieces)])]),
+ ErrorSpecs = [ErrorSpec]
+ ),
+ io.remove_file(TermFileName, _RemoveRes, !IO).
+
+:- pred read_specs_file(string::in, string::in, string::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_decl("C",
+"
+#include ""mercury_event_spec.h""
+#include <stdio.h>
+").
+
+:- pragma foreign_proc("C",
+ read_specs_file(SpecsFileName::in, TermFileName::in, Problem::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ int spec_fd;
+ FILE *term_fp;
+
+ /*
+ ** Using snprint instead of sprintf below would be very slightly safer,
+ ** but unfortunately enabling the declaration of snprintf in the system's
+ ** header files requires finding the right #defines, and this set of
+ ** #defines is very system-dependent. Even having MR_HAVE_SNPRINTF set
+ ** is no guarantee that calling snprintf won't lead to a warning from
+ ** the C compiler.
+ **
+ ** There race conditions between opening the file, stat'ing the file
+ ** and reading the contents of the file, but the Unix API doesn't really
+ ** allow these race conditions to be resolved.
+ */
+
+ spec_fd = open(SpecsFileName, O_RDONLY);
+ if (spec_fd < 0) {
+ char buf[4096];
+
+ sprintf(buf, ""could not open %s: %s"",
+ SpecsFileName, strerror(errno));
+ MR_make_aligned_string_copy(Problem, buf);
+ } else {
+ struct stat stat_buf;
+
+ if (fstat(spec_fd, &stat_buf) != 0) {
+ char buf[4096];
+
+ sprintf(buf, ""could not stat %s"", SpecsFileName);
+ MR_make_aligned_string_copy(Problem, buf);
+ } else {
+ char *spec_buf;
+
+ spec_buf = malloc(stat_buf.st_size + 1);
+ if (spec_buf == NULL) {
+ char buf[4096];
+
+ sprintf(buf, ""could not allocate memory for a copy of %s"",
+ SpecsFileName);
+ MR_make_aligned_string_copy(Problem, buf);
+ } else {
+ ssize_t num_bytes_read;
+
+ num_bytes_read = read(spec_fd, spec_buf, stat_buf.st_size);
+ if (num_bytes_read != stat_buf.st_size) {
+ char buf[4096];
+
+ sprintf(buf, ""could not read in %s"", SpecsFileName);
+ MR_make_aligned_string_copy(Problem, buf);
+ } else {
+ /* NULL terminate the string we have read in. */
+ spec_buf[num_bytes_read] = '\\0';
+ if (! MR_read_event_specs(spec_buf)) {
+ char buf[4096];
+
+ sprintf(buf, ""could not parse %s"", SpecsFileName);
+ MR_make_aligned_string_copy(Problem, buf);
+ } else {
+ term_fp = fopen(TermFileName, ""w"");
+ if (term_fp == NULL) {
+ char buf[4096];
+
+ sprintf(buf, ""could not open %s: %s"",
+ TermFileName, strerror(errno));
+ MR_make_aligned_string_copy(Problem, buf);
+ } else {
+ MR_print_event_specs(term_fp);
+ fclose(term_fp);
+
+ /*
+ ** Our caller tests Problem against the
+ ** empty string, not NULL.
+ */
+
+ MR_make_aligned_string_copy(Problem, """");
+ }
+ }
+ }
+
+ free(spec_buf);
+ }
+ }
+
+ (void) close(spec_fd);
+ }
+").
+
+%-----------------------------------------------------------------------------%
+
+:- type event_spec_term
+ ---> event_spec_term(
+ event_name :: string,
+ event_num :: int,
+ event_linenum :: int,
+ event_attrs :: list(event_attr_term)
+ ).
+
+:- type event_attr_term
+ ---> event_attr_term(
+ attr_name :: string,
+ attr_type :: event_attr_type
+ ).
+
+:- type event_attr_type
+ ---> event_attr_type_ordinary(
+ event_attr_type_term
+ )
+ ; event_attr_type_synthesized(
+ event_attr_type_term,
+ event_attr_synth_call
+ )
+ ; event_attr_type_function.
+
+:- type event_attr_type_term
+ ---> event_attr_type_term(
+ string,
+ list(event_attr_type_term)
+ ).
+
+:- pred convert_list_to_spec_map(string::in, list(event_spec_term)::in,
+ event_spec_map::in, event_spec_map::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+convert_list_to_spec_map(_, [], !EventSpecMap, !ErrorSpecs).
+convert_list_to_spec_map(FileName, [SpecTerm | SpecTerms],
+ !EventSpecMap, !ErrorSpecs) :-
+ convert_term_to_spec_map(FileName, SpecTerm, !EventSpecMap, !ErrorSpecs),
+ convert_list_to_spec_map(FileName, SpecTerms, !EventSpecMap, !ErrorSpecs).
+
+:- pred convert_term_to_spec_map(string::in, event_spec_term::in,
+ event_spec_map::in, event_spec_map::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+convert_term_to_spec_map(FileName, SpecTerm, !EventSpecMap, !ErrorSpecs) :-
+ SpecTerm = event_spec_term(EventName, EventNumber, EventLineNumber,
+ AttrTerms),
+
+ % We convert the event_spec_term we have read in to the event_spec_map
+ % table entry we need in three stages.
+ %
+ % Stage 1 is done by build_plain_type_map. This records the types of all
+ % of the ordinary and synthesized attributes in AttrTypeMap0, builds up
+ % KeyMap, which maps each attribute name to its relation_key in DepRel0,
+ % and builds DepRel0, which at the end of stage 1 just contains one key
+ % for each attribute with no relationships between them.
+ %
+ % Stage 2 is done by build_dep_map. This inserts into DepRel all the
+ % dependencies of synthesized attributes on the attributes they are
+ % synthesized from (including the attribute that provides the function).
+ % It also computes the types of the function attributes that are used
+ % to synthesize one or more other attributes.
+ %
+ % Stage 3, implemented by convert_terms_to_attrs, is the final pass.
+ % It does the data format conversion, and performs the last checks.
+
+ build_plain_type_map(EventName, FileName, EventLineNumber, AttrTerms,
+ map.init, AttrTypeMap0, bimap.init, KeyMap, relation.init, DepRel0,
+ !ErrorSpecs),
+ build_dep_map(EventName, FileName, EventLineNumber, KeyMap, AttrTerms,
+ AttrTypeMap0, AttrTypeMap, DepRel0, DepRel, !ErrorSpecs),
+ convert_terms_to_attrs(EventName, FileName, EventLineNumber, AttrTypeMap,
+ AttrTerms, [], RevVisAttrs, [], RevAllAttrs, !ErrorSpecs),
+ ( relation.tsort(DepRel, _AttrOrder) ->
+ % There is an order for computing the synthesized attributes.
+ % XXX We should record this order for use by the debugger.
+ true
+ ;
+ Pieces = [words("Circular dependency among"),
+ words("the synthesized attributes of event"),
+ quote(EventName), suffix("."), nl],
+ CircErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(context(FileName, EventLineNumber),
+ [always(Pieces)])]),
+ !:ErrorSpecs = [CircErrorSpec | !.ErrorSpecs]
+ ),
+ list.reverse(RevVisAttrs, VisAttrs),
+ list.reverse(RevAllAttrs, AllAttrs),
+ EventSpec = event_spec(EventNumber, EventLineNumber, VisAttrs, AllAttrs),
+ ( map.search(!.EventSpecMap, EventName, OldEventSpec) ->
+ OldLineNumber = OldEventSpec ^ event_spec_linenum,
+ Pieces1 = [words("Duplicate event specification for event"),
+ quote(EventName), suffix("."), nl],
+ Pieces2 = [words("The previous event specification is here."), nl],
+ DuplErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(context(FileName, EventLineNumber), [always(Pieces1)]),
+ simple_msg(context(FileName, OldLineNumber), [always(Pieces2)])]),
+ !:ErrorSpecs = [DuplErrorSpec | !.ErrorSpecs]
+ ;
+ svmap.det_insert(EventName, EventSpec, !EventSpecMap)
+ ).
+
+:- type attr_type_map == map(string, mer_type).
+:- type attr_dep_rel == relation(string).
+:- type attr_key_map == bimap(string, relation_key).
+
+ % See the big comment in convert_term_to_spec_map for the documentation
+ % of this predicate.
+ %
+:- pred build_plain_type_map(string::in, string::in, int::in,
+ list(event_attr_term)::in, attr_type_map::in, attr_type_map::out,
+ attr_key_map::in, attr_key_map::out, attr_dep_rel::in, attr_dep_rel::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+build_plain_type_map(_, _, _, [], !AttrTypeMap, !KeyMap, !DepRel, !ErrorSpecs).
+build_plain_type_map(EventName, FileName, LineNumber, [AttrTerm | AttrTerms],
+ !AttrTypeMap, !KeyMap, !DepRel, !ErrorSpecs) :-
+ AttrTerm = event_attr_term(AttrName, AttrTypeTerm),
+ svrelation.add_element(AttrName, AttrKey, !DepRel),
+ ( svbimap.insert(AttrName, AttrKey, !KeyMap) ->
+ true
+ ;
+ Pieces = [words("Event"), quote(EventName),
+ words("has more than one attribute named"),
+ quote(AttrName), suffix("."), nl],
+ ErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(context(FileName, LineNumber), [always(Pieces)])]),
+ !:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
+ ),
+ (
+ ( AttrTypeTerm = event_attr_type_ordinary(TypeTerm)
+ ; AttrTypeTerm = event_attr_type_synthesized(TypeTerm, _SynthCall)
+ ),
+ Type = convert_term_to_type(TypeTerm),
+ ( map.search(!.AttrTypeMap, AttrName, _OldType) ->
+ % The error message has already been generated above.
+ true
+ ;
+ svmap.det_insert(AttrName, Type, !AttrTypeMap)
+ )
+ ;
+ AttrTypeTerm = event_attr_type_function
+ ),
+ build_plain_type_map(EventName, FileName, LineNumber, AttrTerms,
+ !AttrTypeMap, !KeyMap, !DepRel, !ErrorSpecs).
+
+ % See the big comment in convert_term_to_spec_map for the documentation
+ % of this predicate.
+ %
+:- pred build_dep_map(string::in, string::in, int::in,
+ attr_key_map::in, list(event_attr_term)::in,
+ attr_type_map::in, attr_type_map::out, attr_dep_rel::in, attr_dep_rel::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+build_dep_map(_, _, _, _, [], !AttrTypeMap, !DepRel, !ErrorSpecs).
+build_dep_map(EventName, FileName, LineNumber, KeyMap,
+ [AttrTerm | AttrTerms], !AttrTypeMap, !DepRel, !ErrorSpecs) :-
+ AttrTerm = event_attr_term(AttrName, AttrTypeTerm),
+ bimap.lookup(KeyMap, AttrName, AttrKey),
+ (
+ AttrTypeTerm = event_attr_type_synthesized(_TypeTerm, SynthCall),
+ SynthCall = event_attr_synth_call(FuncAttrName, ArgAttrs),
+ record_arg_dependencies(EventName, FileName, LineNumber, KeyMap,
+ AttrName, AttrKey, ArgAttrs, !DepRel, [], AttrErrorSpecs),
+ (
+ AttrErrorSpecs = [_ | _],
+ !:ErrorSpecs = AttrErrorSpecs ++ !.ErrorSpecs
+ ;
+ AttrErrorSpecs = [],
+ map.lookup(!.AttrTypeMap, AttrName, AttrType),
+ ArgTypes = list.map(map.lookup(!.AttrTypeMap), ArgAttrs),
+ FuncAttrType = higher_order_type(ArgTypes, yes(AttrType),
+ purity_pure, lambda_normal),
+ ( map.search(!.AttrTypeMap, FuncAttrName, OldFuncAttrType) ->
+ ( FuncAttrType = OldFuncAttrType ->
+ % AttrTypeMap already contains the correct info.
+ true
+ ;
+ % XXX Maybe we should give the types themselves.
+ Pieces = [words("Attribute"), quote(FuncAttrName),
+ words("is assigned inconsistent types"),
+ words("by synthesized attributes."), nl],
+ ErrorSpec = error_spec(severity_error,
+ phase_term_to_parse_tree,
+ [simple_msg(context(FileName, LineNumber),
+ [always(Pieces)])]),
+ !:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
+ )
+ ;
+ svmap.det_insert(FuncAttrName, FuncAttrType, !AttrTypeMap)
+ )
+ )
+ ;
+ AttrTypeTerm = event_attr_type_ordinary(_TypeTerm)
+ ;
+ AttrTypeTerm = event_attr_type_function
+ ),
+ build_dep_map(EventName, FileName, LineNumber, KeyMap, AttrTerms,
+ !AttrTypeMap, !DepRel, !ErrorSpecs).
+
+:- pred record_arg_dependencies(string::in, string::in, int::in,
+ attr_key_map::in, string::in, relation_key::in,
+ list(string)::in, attr_dep_rel::in, attr_dep_rel::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+record_arg_dependencies(_, _, _, _, _, _, [], !DepRel, !ErrorSpecs).
+record_arg_dependencies(EventName, FileName, LineNumber, KeyMap,
+ FunctionAttrName, FunctionAttrKey, [AttrName | AttrNames],
+ !DepRel, !ErrorSpecs) :-
+ ( bimap.search(KeyMap, AttrName, AttrKey) ->
+ svrelation.add(FunctionAttrKey, AttrKey, !DepRel)
+ ;
+ Pieces = [words("Attribute"), quote(FunctionAttrName),
+ words("of event"), quote(EventName),
+ words("uses nonexistent attribute"), quote(AttrName),
+ words("in its synthesis."), nl],
+ ErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(context(FileName, LineNumber), [always(Pieces)])]),
+ !:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
+ ),
+ record_arg_dependencies(EventName, FileName, LineNumber, KeyMap,
+ FunctionAttrName, FunctionAttrKey, AttrNames, !DepRel, !ErrorSpecs).
+
+ % See the big comment in convert_term_to_spec_map for the documentation
+ % of this predicate.
+ %
+:- pred convert_terms_to_attrs(string::in, string::in, int::in,
+ attr_type_map::in, list(event_attr_term)::in,
+ list(event_attribute)::in, list(event_attribute)::out,
+ list(event_attribute)::in, list(event_attribute)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+convert_terms_to_attrs(_, _, _, _, [], !RevVisAttrs, !RevAllAttrs,
+ !ErrorSpecs).
+convert_terms_to_attrs(EventName, FileName, LineNumber, AttrTypeMap,
+ [AttrTerm | AttrTerms], !RevVisAttrs, !RevAllAttrs, !ErrorSpecs) :-
+ AttrTerm = event_attr_term(AttrName, AttrTypeTerm),
+ (
+ AttrTypeTerm = event_attr_type_ordinary(_),
+ map.lookup(AttrTypeMap, AttrName, AttrType),
+ EventAttr = event_attribute(AttrName, AttrType, in_mode, no),
+ !:RevVisAttrs = [EventAttr | !.RevVisAttrs],
+ !:RevAllAttrs = [EventAttr | !.RevAllAttrs]
+ ;
+ AttrTypeTerm = event_attr_type_synthesized(_, SynthCall),
+ map.lookup(AttrTypeMap, AttrName, AttrType),
+ EventAttr = event_attribute(AttrName, AttrType, in_mode,
+ yes(SynthCall)),
+ !:RevAllAttrs = [EventAttr | !.RevAllAttrs]
+ ;
+ AttrTypeTerm = event_attr_type_function,
+ ( map.search(AttrTypeMap, AttrName, AttrType) ->
+ EventAttr = event_attribute(AttrName, AttrType, in_mode, no),
+ !:RevVisAttrs = [EventAttr | !.RevVisAttrs],
+ !:RevAllAttrs = [EventAttr | !.RevAllAttrs]
+ ;
+ Pieces = [words("Event"), quote(EventName),
+ words("does not use the function attribute"),
+ quote(AttrName), suffix("."), nl],
+ ErrorSpec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(context(FileName, LineNumber), [always(Pieces)])]),
+ !:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
+ )
+ ),
+ convert_terms_to_attrs(EventName, FileName, LineNumber, AttrTypeMap,
+ AttrTerms, !RevVisAttrs, !RevAllAttrs, !ErrorSpecs).
+
+:- func convert_term_to_type(event_attr_type_term) = mer_type.
+
+convert_term_to_type(Term) = Type :-
+ Term = event_attr_type_term(Name, Args),
+ (
+ Args = [],
+ builtin_type_to_string(BuiltinType, Name)
+ ->
+ Type = builtin_type(BuiltinType)
+ ;
+ SymName = string_to_sym_name(Name),
+ ArgTypes = list.map(convert_term_to_type, Args),
+ Type = defined_type(SymName, ArgTypes, kind_star)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+event_set_description(EventSpecMap) = Desc :-
+ map.to_assoc_list(EventSpecMap, EventSpecList),
+ list.sort(compare_event_specs_by_num, EventSpecList, SortedEventSpecList),
+ DescStrings = list.map(describe_event_spec, SortedEventSpecList),
+ string.append_list(DescStrings, Desc).
+
+:- pred compare_event_specs_by_num(
+ pair(string, event_spec)::in, pair(string, event_spec)::in,
+ comparison_result::out) is det.
+
+compare_event_specs_by_num(_NameA - SpecA, _NameB - SpecB, Result) :-
+ compare(Result, SpecA ^ event_spec_num, SpecB ^ event_spec_num).
+
+:- func describe_event_spec(pair(string, event_spec)) = string.
+
+describe_event_spec(Name - Spec) = Desc :-
+ Spec = event_spec(_EventNumber, _EventLineNumber, _VisAttrs, AllAttrs),
+ AttrDescs = string.join_list(",\n",
+ list.map(describe_event_attr, AllAttrs)),
+ Desc = "event " ++ Name ++ "(" ++ AttrDescs ++ ")".
+
+:- func describe_event_attr(event_attribute) = string.
+
+describe_event_attr(Attr) = Desc :-
+ Attr = event_attribute(Name, Type, _Mode, MaybeSynthCall),
+ TypeDesc = describe_attr_type(Type),
+ (
+ MaybeSynthCall = no,
+ SynthCallDesc = ""
+ ;
+ MaybeSynthCall = yes(SynthCall),
+ SynthCall = event_attr_synth_call(FuncAttrName, ArgAttrNames),
+ ArgAttrDesc = string.join_list(", ", ArgAttrNames),
+ SynthCallDesc = "synthesized by " ++
+ FuncAttrName ++ "(" ++ ArgAttrDesc ++ ")"
+ ),
+ Desc = Name ++ ": " ++ TypeDesc ++ SynthCallDesc.
+
+:- func describe_attr_type(mer_type) = string.
+
+describe_attr_type(Type) = Desc :-
+ (
+ Type = defined_type(SymName, ArgTypes, Kind),
+ expect(unify(Kind, kind_star), this_file,
+ "describe_attr_type: not kind_star"),
+ ArgTypeDescs = string.join_list(", ",
+ list.map(describe_attr_type, ArgTypes)),
+ Desc = sym_name_to_string(SymName) ++ "(" ++ ArgTypeDescs ++ ")"
+ ;
+ Type = builtin_type(BuiltinType),
+ builtin_type_to_string(BuiltinType, Desc)
+ ;
+ Type = higher_order_type(_, _, _, _),
+ Desc = "function"
+ ;
+ ( Type = type_variable(_, _)
+ ; Type = tuple_type(_, _)
+ ; Type = apply_n_type(_, _, _)
+ ; Type = kinded_type(_, _)
+ ),
+ unexpected(this_file,
+ "describe_attr_type: type not constructed by prog_event")
+ ).
-event_args("test_event",
- [event_attribute("arg1", builtin_type(builtin_type_string), in_mode)]).
+%-----------------------------------------------------------------------------%
-event_arg_names(EventName, ArgNames) :-
- event_args(EventName, ArgInfos),
+event_number(EventSpecMap, EventName, EventNumber) :-
+ map.search(EventSpecMap, EventName, EventSpec),
+ EventNumber = EventSpec ^ event_spec_num.
+
+event_arg_names(EventSpecMap, EventName, ArgNames) :-
+ map.search(EventSpecMap, EventName, EventSpec),
+ ArgInfos = EventSpec ^ event_spec_visible_attrs,
ArgNames = list.map(project_event_arg_name, ArgInfos).
-event_arg_types(EventName, ArgTypes) :-
- event_args(EventName, ArgInfos),
+event_arg_types(EventSpecMap, EventName, ArgTypes) :-
+ map.search(EventSpecMap, EventName, EventSpec),
+ ArgInfos = EventSpec ^ event_spec_visible_attrs,
ArgTypes = list.map(project_event_arg_type, ArgInfos).
-event_arg_modes(EventName, ArgModes) :-
- event_args(EventName, ArgInfos),
+event_arg_modes(EventSpecMap, EventName, ArgModes) :-
+ map.search(EventSpecMap, EventName, EventSpec),
+ ArgInfos = EventSpec ^ event_spec_visible_attrs,
ArgModes = list.map(project_event_arg_mode, ArgInfos).
:- func project_event_arg_name(event_attribute) = string.
@@ -77,3 +621,11 @@
:- func project_event_arg_mode(event_attribute) = mer_mode.
project_event_arg_mode(Attribute) = Attribute ^ attr_mode.
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "event_spec.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.124
diff -u -b -r1.124 stack_layout.m
--- compiler/stack_layout.m 15 Oct 2006 23:26:52 -0000 1.124
+++ compiler/stack_layout.m 19 Nov 2006 15:17:22 -0000
@@ -101,6 +101,7 @@
:- import_module ll_backend.prog_rep.
:- import_module ll_backend.trace_gen.
:- import_module mdbcomp.program_representation.
+:- import_module parse_tree.prog_event.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
@@ -119,9 +120,9 @@
%---------------------------------------------------------------------------%
-generate_llds(ModuleInfo0, !GlobalData, Layouts, LayoutLabels) :-
+generate_llds(ModuleInfo, !GlobalData, Layouts, LayoutLabels) :-
global_data_get_all_proc_layouts(!.GlobalData, ProcLayoutList),
- module_info_get_globals(ModuleInfo0, Globals),
+ module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, agc_stack_layout, AgcLayout),
globals.lookup_bool_option(Globals, trace_stack_layout, TraceLayout),
globals.lookup_bool_option(Globals, procid_stack_layout,
@@ -136,10 +137,10 @@
StringTable0 = string_table(StringMap0, [], 0),
global_data_get_static_cell_info(!.GlobalData, StaticCellInfo0),
counter.init(1, LabelCounter0),
- LayoutInfo0 = stack_layout_info(ModuleInfo0,
+ LayoutInfo0 = stack_layout_info(ModuleInfo,
AgcLayout, TraceLayout, ProcIdLayout, StaticCodeAddr,
LabelCounter0, [], [], [], LayoutLabels0, [],
- StringTable0, LabelTables0, StaticCellInfo0),
+ StringTable0, LabelTables0, StaticCellInfo0, no),
lookup_string_in_table("", _, LayoutInfo0, LayoutInfo1),
lookup_string_in_table("<too many variables>", _,
LayoutInfo1, LayoutInfo2),
@@ -162,7 +163,7 @@
list.condense([TableIoDecls, ProcLayouts, InternalLayouts], Layouts0),
(
TraceLayout = yes,
- module_info_get_name(ModuleInfo0, ModuleName),
+ module_info_get_name(ModuleInfo, ModuleName),
globals.lookup_bool_option(Globals, rtti_line_numbers, LineNumbers),
(
LineNumbers = yes,
@@ -173,9 +174,19 @@
),
format_label_tables(EffLabelTables, SourceFileLayouts),
SuppressedEvents = encode_suppressed_events(TraceSuppress),
+ HasUserEvent = LayoutInfo ^ has_user_event,
+ (
+ HasUserEvent = no,
+ MaybeEventSpecs = no
+ ;
+ HasUserEvent = yes,
+ module_info_get_event_spec_map(ModuleInfo, EventSpecMap),
+ EventSpecs = event_set_description(EventSpecMap),
+ MaybeEventSpecs = yes(EventSpecs)
+ ),
ModuleLayout = module_layout_data(ModuleName,
StringOffset, ConcatStrings, ProcLayoutNames, SourceFileLayouts,
- TraceLevel, SuppressedEvents, NumLabels),
+ TraceLevel, SuppressedEvents, NumLabels, MaybeEventSpecs),
Layouts = [ModuleLayout | Layouts0]
;
TraceLayout = no,
@@ -808,9 +819,9 @@
Trace = no,
set.init(TraceLiveVarSet),
map.init(TraceTypeVarMap),
- MaybeSolverInfo = no
+ MaybeUserInfo = no
;
- Trace = yes(trace_port_layout_info(_,_,_,_, MaybeSolverInfo,
+ Trace = yes(trace_port_layout_info(_,_,_,_, MaybeUserInfo,
TraceLayout)),
TraceLayout = layout_label_info(TraceLiveVarSet, TraceTypeVarMap)
),
@@ -910,27 +921,29 @@
LabelVars = label_has_var_info
),
(
- MaybeSolverInfo = no,
- MaybeSolverData = no
+ MaybeUserInfo = no,
+ MaybeUserData = no
;
- MaybeSolverInfo = yes(SolverInfo),
- SolverInfo = solver_event_info(SolverEventName, Attributes),
+ MaybeUserInfo = yes(UserInfo),
+ set_has_user_event(yes, !Info),
+ UserInfo = user_event_info(UserEventNumber, UserEventName,
+ Attributes),
list.length(Attributes, NumAttributes),
- construct_solver_data_array(Attributes,
- SolverLocnsArray, SolverTypesArray, SolverAttrNames, !Info),
+ construct_user_data_array(Attributes,
+ UserLocnsArray, UserTypesArray, UserAttrNames, !Info),
get_static_cell_info(!.Info, StaticCellInfo0),
- add_scalar_static_cell(SolverLocnsArray, SolverLocnsDataAddr,
+ add_scalar_static_cell(UserLocnsArray, UserLocnsDataAddr,
StaticCellInfo0, StaticCellInfo1),
- add_scalar_static_cell(SolverTypesArray, SolverTypesDataAddr,
+ add_scalar_static_cell(UserTypesArray, UserTypesDataAddr,
StaticCellInfo1, StaticCellInfo),
set_static_cell_info(StaticCellInfo, !Info),
- SolverLocnsRval = const(llconst_data_addr(SolverLocnsDataAddr, no)),
- SolverTypesRval = const(llconst_data_addr(SolverTypesDataAddr, no)),
- SolverData = solver_event_data(SolverEventName, NumAttributes,
- SolverLocnsRval, SolverTypesRval, SolverAttrNames),
- MaybeSolverData = yes(SolverData)
+ UserLocnsRval = const(llconst_data_addr(UserLocnsDataAddr, no)),
+ UserTypesRval = const(llconst_data_addr(UserTypesDataAddr, no)),
+ UserData = user_event_data(UserEventNumber, UserEventName,
+ NumAttributes, UserLocnsRval, UserTypesRval, UserAttrNames),
+ MaybeUserData = yes(UserData)
),
(
@@ -949,22 +962,22 @@
LabelNumber = 0
),
LayoutData = label_layout_data(ProcLabel, LabelNum, ProcLayoutName,
- MaybePort, MaybeIsHidden, LabelNumber, MaybeGoalPath, MaybeSolverData,
+ MaybePort, MaybeIsHidden, LabelNumber, MaybeGoalPath, MaybeUserData,
MaybeVarInfo),
LayoutName = label_layout(ProcLabel, LabelNum, LabelVars),
Label = internal_label(LabelNum, ProcLabel),
add_internal_layout_data(LayoutData, Label, LayoutName, !Info),
LabelLayout = {ProcLabel, LabelNum, LabelVars, Internal}.
-:- pred construct_solver_data_array(list(solver_attribute)::in,
+:- pred construct_user_data_array(list(user_attribute)::in,
assoc_list(rval, llds_type)::out, assoc_list(rval, llds_type)::out,
list(string)::out, stack_layout_info::in, stack_layout_info::out) is det.
-construct_solver_data_array([], [], [], [], !Info).
-construct_solver_data_array([Attr | Attrs],
+construct_user_data_array([], [], [], [], !Info).
+construct_user_data_array([Attr | Attrs],
[LocnRvalAndType | LocnRvalAndTypes],
[TypeRvalAndType | TypeRvalAndTypes], [Name | Names], !Info) :-
- Attr = solver_attribute(Locn, Type, Name),
+ Attr = user_attribute(Locn, Type, Name),
represent_locn_or_const_as_int_rval(Locn, LocnRval, LocnRvalType, !Info),
LocnRvalAndType = LocnRval - LocnRvalType,
@@ -977,7 +990,7 @@
set_static_cell_info(StaticCellInfo, !Info),
TypeRvalAndType = TypeRval - TypeRvalType,
- construct_solver_data_array(Attrs, LocnRvalAndTypes, TypeRvalAndTypes,
+ construct_user_data_array(Attrs, LocnRvalAndTypes, TypeRvalAndTypes,
Names, !Info).
%---------------------------------------------------------------------------%
@@ -1659,7 +1672,7 @@
:- pred make_tagged_byte(int::in, int::in, int::out) is det.
make_tagged_byte(Tag, Value, TaggedValue) :-
- TaggedValue is unchecked_left_shift(Value, short_lval_tag_bits) + Tag.
+ TaggedValue = unchecked_left_shift(Value, short_lval_tag_bits) + Tag.
:- func short_lval_tag_bits = int.
@@ -1719,7 +1732,8 @@
% contributes labels to this module
% to a table describing those
% labels.
- static_cell_info :: static_cell_info
+ static_cell_info :: static_cell_info,
+ has_user_event :: bool
).
:- pred get_module_info(stack_layout_info::in, module_info::out) is det.
@@ -1739,6 +1753,7 @@
is det.
:- pred get_static_cell_info(stack_layout_info::in, static_cell_info::out)
is det.
+:- pred get_has_user_event(stack_layout_info::in, bool::out) is det.
get_module_info(LI, LI ^ module_info).
get_agc_stack_layout(LI, LI ^ agc_stack_layout).
@@ -1752,6 +1767,7 @@
get_string_table(LI, LI ^ string_table).
get_label_tables(LI, LI ^ label_tables).
get_static_cell_info(LI, LI ^ static_cell_info).
+get_has_user_event(LI, LI ^ has_user_event).
:- pred allocate_label_number(int::out,
stack_layout_info::in, stack_layout_info::out) is det.
@@ -1809,9 +1825,13 @@
:- pred set_static_cell_info(static_cell_info::in,
stack_layout_info::in, stack_layout_info::out) is det.
+:- pred set_has_user_event(bool::in,
+ stack_layout_info::in, stack_layout_info::out) is det.
+
set_string_table(ST, LI, LI ^ string_table := ST).
set_label_tables(LT, LI, LI ^ label_tables := LT).
set_static_cell_info(SCI, LI, LI ^ static_cell_info := SCI).
+set_has_user_event(HUE, LI, LI ^ has_user_event := HUE).
%---------------------------------------------------------------------------%
%
Index: compiler/trace_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_gen.m,v
retrieving revision 1.8
diff -u -b -r1.8 trace_gen.m
--- compiler/trace_gen.m 15 Oct 2006 23:26:54 -0000 1.8
+++ compiler/trace_gen.m 13 Nov 2006 12:31:19 -0000
@@ -196,9 +196,9 @@
:- pred maybe_generate_pragma_event_code(nondet_pragma_trace_port::in,
prog_context::in, code_tree::out, code_info::in, code_info::out) is det.
- % Generate code for a solver trace event.
+ % Generate code for a user-defined trace event.
%
-:- pred generate_solver_event_code(solver_event_info::in, hlds_goal_info::in,
+:- pred generate_user_event_code(user_event_info::in, hlds_goal_info::in,
code_tree::out, code_info::in, code_info::out) is det.
:- type external_event_info
@@ -276,7 +276,7 @@
% (one way or another) this port
% represents.
)
- ; port_info_solver(
+ ; port_info_user(
goal_path % The path of the goal.
)
; port_info_nondet_pragma.
@@ -782,15 +782,15 @@
Code = empty
).
-generate_solver_event_code(SolverInfo, GoalInfo, Code, !CI) :-
+generate_user_event_code(UserInfo, GoalInfo, Code, !CI) :-
goal_info_get_goal_path(GoalInfo, Path),
goal_info_get_context(GoalInfo, Context),
- Port = port_solver,
- PortInfo = port_info_solver(Path),
+ Port = port_user,
+ PortInfo = port_info_user(Path),
MaybeTraceInfo = no,
HideEvent = no,
generate_event_code(Port, PortInfo, MaybeTraceInfo, Context, HideEvent,
- yes(SolverInfo), _Label, _TvarDataMap, Code, !CI).
+ yes(UserInfo), _Label, _TvarDataMap, Code, !CI).
generate_external_event_code(ExternalPort, TraceInfo, Context,
MaybeExternalInfo, !CI) :-
@@ -811,12 +811,12 @@
:- pred generate_event_code(trace_port::in, trace_port_info::in,
maybe(trace_info)::in, prog_context::in, bool::in,
- maybe(solver_event_info)::in, label::out,
+ maybe(user_event_info)::in, label::out,
map(tvar, set(layout_locn))::out, code_tree::out,
code_info::in, code_info::out) is det.
generate_event_code(Port, PortInfo, MaybeTraceInfo, Context, HideEvent,
- MaybeSolverInfo, Label, TvarDataMap, Code, !CI) :-
+ MaybeUserInfo, Label, TvarDataMap, Code, !CI) :-
code_info.get_next_label(Label, !CI),
code_info.get_known_variables(!.CI, LiveVars0),
(
@@ -833,7 +833,7 @@
PortInfo = port_info_negation_end(Path),
LiveVars = LiveVars0
;
- PortInfo = port_info_solver(Path),
+ PortInfo = port_info_user(Path),
LiveVars = LiveVars0
;
PortInfo = port_info_nondet_pragma,
@@ -878,14 +878,14 @@
LayoutLabelInfo = layout_label_info(VarInfoSet, TvarDataMap),
LabelStr = llds_out.label_to_c_string(Label, no),
(
- MaybeSolverInfo = no,
+ MaybeUserInfo = no,
TraceStmt = "\t\tMR_EVENT(" ++ LabelStr ++ ")\n"
;
- MaybeSolverInfo = yes(_),
- TraceStmt = "\t\tMR_SOLVER_EVENT(" ++ LabelStr ++ ")\n"
+ MaybeUserInfo = yes(_),
+ TraceStmt = "\t\tMR_USER_EVENT(" ++ LabelStr ++ ")\n"
),
code_info.add_trace_layout_for_label(Label, Context, Port, HideEvent,
- Path, MaybeSolverInfo, LayoutLabelInfo, !CI),
+ Path, MaybeUserInfo, LayoutLabelInfo, !CI),
(
Port = port_fail,
MaybeTraceInfo = yes(TraceInfo),
Index: compiler/trace_params.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_params.m,v
retrieving revision 1.36
diff -u -b -r1.36 trace_params.m
--- compiler/trace_params.m 29 Sep 2006 06:34:51 -0000 1.36
+++ compiler/trace_params.m 13 Nov 2006 12:30:12 -0000
@@ -382,8 +382,7 @@
convert_port_name("nondet_pragma_first") = port_nondet_pragma_first.
convert_port_name("latr") = port_nondet_pragma_first.
convert_port_name("nondet_pragma_later") = port_nondet_pragma_later.
-convert_port_name("slvr") = port_solver.
-convert_port_name("solver") = port_solver.
+convert_port_name("user") = port_user.
:- func convert_port_class_name(string) = list(trace_port) is semidet.
@@ -444,8 +443,8 @@
% the declarative debugger needs to know when (potentially)
% negated contexts start and end.
- ; port_cat_solver.
- % Solver events.
+ ; port_cat_user.
+ % User defined events.
:- func trace_port_category(trace_port) = port_category.
@@ -464,16 +463,16 @@
trace_port_category(port_disj) = port_cat_internal.
trace_port_category(port_nondet_pragma_first) = port_cat_internal.
trace_port_category(port_nondet_pragma_later) = port_cat_internal.
-trace_port_category(port_solver) = port_cat_solver.
+trace_port_category(port_user) = port_cat_user.
:- func trace_level_port_categories(trace_level) = list(port_category).
trace_level_port_categories(none) = [].
trace_level_port_categories(shallow) = [port_cat_interface].
trace_level_port_categories(deep) =
- [port_cat_interface, port_cat_internal, port_cat_context, port_cat_solver].
+ [port_cat_interface, port_cat_internal, port_cat_context, port_cat_user].
trace_level_port_categories(decl_rep) =
- [port_cat_interface, port_cat_internal, port_cat_context, port_cat_solver].
+ [port_cat_interface, port_cat_internal, port_cat_context, port_cat_user].
:- func trace_level_allows_port_suppression(trace_level) = bool.
@@ -528,4 +527,4 @@
port_number(port_switch) = 13.
port_number(port_nondet_pragma_first) = 14.
port_number(port_nondet_pragma_later) = 15.
-port_number(port_solver) = 16.
+port_number(port_user) = 16.
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.410
diff -u -b -r1.410 typecheck.m
--- compiler/typecheck.m 6 Nov 2006 07:55:14 -0000 1.410
+++ compiler/typecheck.m 13 Nov 2006 13:49:16 -0000
@@ -1514,7 +1514,9 @@
typecheck_info::in, typecheck_info::out) is det.
typecheck_event_call(EventName, Args, !Info) :-
- ( event_arg_types(EventName, EventArgTypes) ->
+ typecheck_info_get_module_info(!.Info, ModuleInfo),
+ module_info_get_event_spec_map(ModuleInfo, EventSpecMap),
+ ( event_arg_types(EventSpecMap, EventName, EventArgTypes) ->
typecheck_var_has_type_list(Args, EventArgTypes, 1, !Info)
;
Spec = report_unknown_event_call_error(!.Info, EventName),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/mdb_categories
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/mdb_categories,v
retrieving revision 1.34
diff -u -b -r1.34 mdb_categories
--- doc/mdb_categories 13 Jun 2006 09:48:59 -0000 1.34
+++ doc/mdb_categories 19 Nov 2006 02:23:17 -0000
@@ -15,7 +15,8 @@
document_category 200 forward
forward - Commands that move execution forward.
The forward commands are `step', `goto', `next', `finish',
- `exception', `forward', `mindepth', `maxdepth' and `continue'.
+ `fail', `exception', `return', `user, `forward',
+ `mindepth', `maxdepth' and `continue'.
end
document_category 300 backward
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.498
diff -u -b -r1.498 user_guide.texi
--- doc/user_guide.texi 3 Nov 2006 08:31:19 -0000 1.498
+++ doc/user_guide.texi 19 Nov 2006 03:02:56 -0000
@@ -1190,6 +1190,7 @@
* Tracing optimized code::
* Mercury debugger invocation::
* Mercury debugger concepts::
+* User defined events::
* I/O tabling::
* Debugger commands::
* Declarative debugging::
@@ -1253,9 +1254,9 @@
@end example
-For each trace event, the debugger prints out several pieces of
-information. The three numbers at the start of the display are the
-event number, the call sequence number, and the call depth.
+For each trace event, the debugger prints out several pieces of information.
+The three numbers at the start of the display are
+the event number, the call sequence number, and the call depth.
(You don't really need to pay too much attention to those.)
They are followed by the event type (e.g.@: @samp{CALL} or @samp{EXIT}).
After that comes the identification of the procedure
@@ -1432,9 +1433,8 @@
The Mercury debugger is based on a modified version of the box model
on which the four-port debuggers of most Prolog systems are based.
-Such debuggers abstract the execution of a program
-into a sequence, also called a @emph{trace},
-of execution events of various kinds.
+Such debuggers abstract the execution of a program into a sequence,
+also called a @emph{trace}, of execution events of various kinds.
The four kinds of events supported by most Prolog systems (their @emph{ports})
are
@@ -1554,7 +1554,7 @@
@cindex path
@cindex goal path
-A path is a sequence of path components separated by semicolons.
+A goal path is a sequence of path components separated by semicolons.
Each path component is one of the following:
@table @code
@@ -1580,12 +1580,12 @@
that doesn't change the determinism of the goal.
@end table
-A path describes the position of a goal
+A goal path describes the position of a goal
inside the body of a procedure definition.
For example, if the procedure body is a disjunction
in which each disjunct is a conjunction,
-then the path @samp{d2;c3;} denotes the third conjunct
-within the second disjunct.
+then the goal path @samp{d2;c3;} denotes
+the third conjunct within the second disjunct.
If the third conjunct within the second disjunct is an atomic goal
such as a call or a unification,
then this will be the only goal with whose path has @samp{d2;c3;} as a prefix.
@@ -1595,7 +1595,7 @@
then its three components will have the paths
@samp{d2;c3;?;}, @samp{d2;c3;t;} and @samp{d2;c3;e;}.
-Paths refer to the internal form of the procedure definition.
+Goal paths refer to the internal form of the procedure definition.
When debugging is enabled
(and the option @samp{--trace-optimized} is not given),
the compiler will try to keep this form
@@ -1656,11 +1656,12 @@
The ``decldebug'' grades improve declarative debugging by allowing the user
to track the source of subterms (see @ref{Improving the search}).
-Doing this increases the size of executables so these
-grades should only be used when the subterm dependency tracking feature
-of the declarative debugger is required.
-Note that declarative debugging, with the exception of the subterm dependency
-tracking features, also works in the .debug grades.
+Doing this increases the size of executables,
+so these grades should only be used when you need
+the subterm dependency tracking feature of the declarative debugger.
+Note that declarative debugging,
+with the exception of the subterm dependency tracking features,
+also works in the .debug grades.
The two drawbacks of using a debugging grade
are the large size of the resulting executables,
@@ -2062,6 +2063,31 @@
users can ask for a held variable
by prefixing the name of the held variable with a dollar sign.
@sp 1
+ at item user defined events
+ at cindex user defined events (in mdb)
+Besides the built-in set of events,
+the Mercury debugger also supports events defined by the user.
+Each event appears in the source code of the Mercury program
+as a call prefixed by the keyword @samp{event},
+with each argument of the call giving the value of an event @emph{attribute}.
+Users can specify the set of user defined events that can appear in a program,
+and the names, types and order of the attributes
+of each kind of user defined event,
+by giving the name of an event set specification file to the compiler
+when compiling that program.
+For more details, see @ref{User defined events}.
+ at sp 1
+ at item user defined event attributes
+ at cindex user defined event attributes (in mdb)
+Normally, the only variables from the program accessible in the debugger
+are the variables in the current environment at the current program point.
+However, if the current event is a user defined event,
+then the attributes of that event are also available.
+All the commands that accept variable names
+also accept the names of attributes;
+users can ask for a held variable
+by prefixing the name of the attribute with an exclamation point.
+ at sp 1
@item procedure specification
@cindex procedure specification (in mdb)
@cindex debugger procedure specification
@@ -2114,6 +2140,73 @@
@end itemize
@end table
+ at node User defined events
+ at section User defined events
+
+Besides the built-in set of events,
+the Mercury debugger also supports events defined by the user.
+The intention is that users can define one kind of event
+for each semantically important event in the program
+that isn't captured by the standard builtin events,
+and can then generate those events at the appropriate point in the source code.
+Each event appears in the source code
+as a call prefixed by the keyword @samp{event},
+with each argument of the call giving the value of an event @emph{attribute}.
+
+Users can specify the set of user defined events that can appear in a program,
+and the names, types and order of the attributes
+of each kind of user defined event,
+by giving the name of an event set specification file to the compiler
+when compiling that program
+as the argument of the @samp{event-spec-file-name} option.
+This file should contain a sequence of one or more event specifications,
+like this:
+
+ at c XXX replace with more realistic example
+ at example
+ event nodiag_fail(
+ test_failed: string,
+ arg_b: int,
+ arg_d: int,
+ arg_list: list(int)
+ )
+
+ event safe_test(
+ test_list: listint
+ )
+
+ event noargs
+ at end example
+
+Each event specification consists of the keyword @samp{event},
+the name of the event, and,
+if the event has any attributes, a parenthesized list of those attributes.
+Each attribute's specification consists of
+a name, a colon and the Mercury type of that attribute.
+
+Each event goal in the program must use
+the name of one of the events defined here as the predicate name of the call,
+and the call's arguments must match the types of that event's attributes.
+This event goal is fine,
+ at example
+ event safe_test([1, 2, 3])
+ at end example
+but this goal
+ at example
+ event safe_test([1], [2])
+ at end example
+this goal
+ at example
+ event safe_test(42)
+ at end example
+and this goal
+ at example
+ event nonexistent_event(42)
+ at end example
+will all generate errors.
+
+All event attributes are always input, and the event goal is always @samp{det}.
+
@node I/O tabling
@section I/O tabling
@@ -2413,6 +2506,19 @@
@sp 1
By default, this command is strict, and it uses the default print level.
@sp 1
+ at item user [-NSans]
+ at kindex return (mdb command)
+Continues the program until the next user defined event.
+ at sp 1
+The options @samp{-n} or @samp{--none}, @samp{-s} or @samp{--some},
+ at samp{-a} or @samp{--all} specify the print level to use
+for the duration of the command,
+while the options @samp{-S} or @samp{--strict}
+and @samp{-N} or @samp{--nostrict} specify
+the strictness of the command.
+ at sp 1
+By default, this command is strict, and it uses the default print level.
+ at sp 1
@item forward [-NSans]
@kindex forward (mdb command)
Continues the program until the program resumes forward execution,
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: [05:16:34] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/extras/gator/generations/1
cvs diff: [05:17:04] obtained lock in /home/mercury/mercury1/repository/mercury/extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: [05:17:08] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/extras/odbc
cvs diff: [05:17:38] obtained lock in /home/mercury/mercury1/repository/mercury/extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: [05:17:41] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/library
cvs diff: [05:18:11] obtained lock in /home/mercury/mercury1/repository/mercury/library
cvs diff: Diffing mdbcomp
Index: mdbcomp/prim_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/prim_data.m,v
retrieving revision 1.14
diff -u -b -r1.14 prim_data.m
--- mdbcomp/prim_data.m 2 Oct 2006 05:21:38 -0000 1.14
+++ mdbcomp/prim_data.m 13 Nov 2006 13:38:57 -0000
@@ -48,7 +48,7 @@
; port_switch
; port_nondet_pragma_first
; port_nondet_pragma_later
- ; port_solver.
+ ; port_user.
% was in compiler/prog_data.m
Index: mdbcomp/trace_counts.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/trace_counts.m,v
retrieving revision 1.15
diff -u -b -r1.15 trace_counts.m
--- mdbcomp/trace_counts.m 2 Oct 2006 05:21:38 -0000 1.15
+++ mdbcomp/trace_counts.m 13 Nov 2006 13:39:48 -0000
@@ -702,7 +702,7 @@
string_to_trace_port("SWTC", port_switch).
string_to_trace_port("FRST", port_nondet_pragma_first).
string_to_trace_port("LATR", port_nondet_pragma_later).
-string_to_trace_port("SLVR", port_solver).
+string_to_trace_port("USER", port_user).
:- func string_to_goal_path(string) = goal_path is semidet.
@@ -734,7 +734,7 @@
make_path_port(GoalPath, port_switch) = path_only(GoalPath).
make_path_port(GoalPath, port_nondet_pragma_first) = path_only(GoalPath).
make_path_port(GoalPath, port_nondet_pragma_later) = path_only(GoalPath).
-make_path_port(_GoalPath, port_solver) = port_only(port_call).
+make_path_port(_GoalPath, port_user) = port_only(port_call).
%-----------------------------------------------------------------------------%
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: [05:18:12] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/runtime
cvs diff: [05:18:42] obtained lock in /home/mercury/mercury1/repository/mercury/runtime
Index: runtime/mercury_goto.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_goto.h,v
retrieving revision 1.46
diff -u -b -r1.46 mercury_goto.h
--- runtime/mercury_goto.h 29 Sep 2006 06:34:54 -0000 1.46
+++ runtime/mercury_goto.h 13 Nov 2006 12:39:56 -0000
@@ -84,8 +84,8 @@
MR_PASTE2(mercury_data__proc_layout__,label)
#define MR_LABEL_LAYOUT_NAME(label) \
MR_PASTE2(mercury_data__label_layout__,label)
-#define MR_SOLVER_LAYOUT_NAME(label) \
- MR_PASTE2(mercury_data__solver_layout__,label)
+#define MR_USER_LAYOUT_NAME(label) \
+ MR_PASTE2(mercury_data__user_event_layout__,label)
#define MR_PROC_LAYOUT(label) \
((const MR_Proc_Layout *) (MR_Word) &MR_PROC_LAYOUT_NAME(label))
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.101
diff -u -b -r1.101 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 14 Nov 2006 00:22:34 -0000 1.101
+++ runtime/mercury_stack_layout.h 18 Nov 2006 15:33:32 -0000
@@ -9,19 +9,20 @@
/*
** mercury_stack_layout.h -
-** Definitions for stack layout data structures. These are generated by
-** the compiler, and are used by the parts of the runtime system that need
-** to look at the stacks (and sometimes the registers) and make sense of
-** their contents. The parts of the runtime system that need to do this
-** include exception handling, the debugger, and (eventually) the
-** accurate garbage collector.
+**
+** Definitions for stack layout data structures. These are generated by the
+** compiler, and are used by the parts of the runtime system that need to look
+** at the stacks (and sometimes the registers) and make sense of their
+** contents. The parts of the runtime system that need to do this include
+** exception handling, the debugger, and (eventually) the accurate garbage
+** collector.
**
** For a general description of the idea of stack layouts, see the paper
** "Run time type information in Mercury" by Tyson Dowd, Zoltan Somogyi,
-** Fergus Henderson, Thomas Conway and David Jeffery, which is available
-** from the Mercury web site. The relevant section is section 3.8, but be
-** warned: while the general principles remain applicable, the details
-** have changed since that paper was written.
+** Fergus Henderson, Thomas Conway and David Jeffery, which is available from
+** the Mercury web site. The relevant section is section 3.8, but be warned:
+** while the general principles remain applicable, the details have changed
+** since that paper was written.
**
** NOTE: The constants and data-structures used here need to be kept in
** sync with the ones generated in the compiler. If you change anything here,
@@ -240,15 +241,14 @@
/*-------------------------------------------------------------------------*/
/*
-** Definitions for MR_Solver_Event
+** Definitions for MR_UserEvent
*/
/*
-** This is the initial, temporary definition of the solver event structure.
+** This is the initial, temporary definition of the user-defined event
+** structure.
**
-** The port is initially represented as a string. Later, once the set of solver
-** event kinds is settled, it will be a value of an enum type representing all
-** those kinds.
+** The port is represented as both an integer and a string.
**
** The num_attributes field gives the number of attributes. Once the runtime
** system knows the number of attributes of each kind of event, this field may
@@ -257,26 +257,25 @@
** The next three fields all point to an array whose length is the number of
** attributes.
**
-** solver_event->MR_se_attribute_locns[i] gives the location where we can find
+** user_event->MR_ue_attr_locns[i] gives the location where we can find
** the value of the (i+1)th attribute (since we start counting attributes at
** one). This field will stay.
**
-** solver_event->MR_se_attribute_types[i] is the typeinfo giving the type
-** of the (i+1)th attribute. If we find that all attributes of all events
-** have a fixed type, this field may disappear.
-**
-** solver_event->MR_se_attribute_names[i] gives the name of the (i+1)th
-** attribute. Once attribute names have settled down and the future code in the
-** trace directory that manipulates solver events has learned these names,
-** this field will disappear.
-*/
-
-struct MR_Solver_Event_Struct {
- const char *MR_se_port;
- MR_uint_least16_t MR_se_num_attributes;
- MR_Long_Lval *MR_se_attribute_locns;
- MR_TypeInfo *MR_se_attribute_types;
- const char **MR_se_attribute_names;
+** user_event->MR_ue_attr_types[i] is the typeinfo giving the type of the
+** (i+1)th attribute. If we find that all attributes of all events have
+** a fixed type, this field may disappear.
+**
+** user_event->MR_ue_attr_names[i] gives the name of the (i+1)th attribute.
+** In the future, this field may disappear.
+*/
+
+struct MR_UserEvent_Struct {
+ MR_uint_least16_t MR_ue_port_number;
+ const char *MR_ue_port_name;
+ MR_uint_least16_t MR_ue_num_attrs;
+ MR_Long_Lval *MR_ue_attr_locns;
+ MR_TypeInfo *MR_ue_attr_types;
+ const char **MR_ue_attr_names;
};
/*-------------------------------------------------------------------------*/
@@ -312,9 +311,9 @@
** MR_label_goal_path to convert the value in the MR_sll_goal_path field to a
** string.
**
-** If the label is the label of a solver event, then the MR_sll_solver_event
-** field will point to information about the solver event; otherwise, the field
-** will be NULL.
+** If the label is the label of a user-defined event, then the
+** MR_sll_user_event field will point to information about the user event;
+** otherwise, the field will be NULL.
**
** The remaining fields give information about the values live at the given
** label, if this information is available. If it is available, the
@@ -410,7 +409,7 @@
MR_int_least8_t MR_sll_hidden;
MR_uint_least16_t MR_sll_label_num_in_module;
MR_uint_least32_t MR_sll_goal_path;
- const MR_Solver_Event *MR_sll_solver_event;
+ const MR_UserEvent *MR_sll_user_event;
MR_Integer MR_sll_var_count; /* >= 0 */
const void *MR_sll_locns_types;
const MR_uint_least16_t *MR_sll_var_nums;
@@ -423,7 +422,7 @@
MR_int_least8_t MR_sll_hidden;
MR_uint_least16_t MR_sll_label_num_in_module;
MR_uint_least32_t MR_sll_goal_path;
- const MR_Solver_Event *MR_sll_solver_event;
+ const MR_UserEvent *MR_sll_user_event;
MR_Integer MR_sll_var_count; /* < 0 */
} MR_Label_Layout_No_Var_Info;
@@ -525,14 +524,14 @@
#define MR_DEF_LLT(e, ln, port, num, path, vc, lt, vn, tv) \
MR_DEF_LL_GEN(e, ln, port, MR_TRUE, num, path, NULL, vc, lt, vn, tv)
-#define MR_DEF_LL_S(e, ln, port, num, path, vc, lt, vn, tv) \
+#define MR_DEF_LL_U(e, ln, port, num, path, vc, lt, vn, tv) \
MR_DEF_LL_GEN(e, ln, port, MR_FALSE, num, path, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
vc, lt, vn, tv)
-#define MR_DEF_LLT_S(e, ln, port, num, path, vc, lt, vn, tv) \
+#define MR_DEF_LLT_U(e, ln, port, num, path, vc, lt, vn, tv) \
MR_DEF_LL_GEN(e, ln, port, MR_TRUE, num, path, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
vc, lt, vn, tv)
#define MR_DEF_LLXCCC(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc, tvt, tvc)\
@@ -557,32 +556,32 @@
MR_XCOMMON(ltt, ltc), \
MR_XCOMMON(vnt, vnc), 0)
-#define MR_DEF_LLXCCC_S(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc, tvt, tvc)\
+#define MR_DEF_LLXCCC_U(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc, tvt, tvc)\
MR_DEF_LL_GEN(e, ln, port, MR_FALSE, num, path, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
vc, \
MR_XCOMMON(ltt, ltc), \
MR_XCOMMON(vnt, vnc), \
MR_XCOMMON(tvt, tvc))
-#define MR_DEF_LLXCC0_S(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc) \
+#define MR_DEF_LLXCC0_U(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc) \
MR_DEF_LL_GEN(e, ln, port, MR_FALSE, num, path, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
vc, \
MR_XCOMMON(ltt, ltc), \
MR_XCOMMON(vnt, vnc), 0)
-#define MR_DEF_LLTXCCC_S(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc, tvt,tvc)\
+#define MR_DEF_LLTXCCC_U(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc, tvt,tvc)\
MR_DEF_LL_GEN(e, ln, port, MR_TRUE, num, path, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
vc, \
MR_XCOMMON(ltt, ltc), \
MR_XCOMMON(vnt, vnc), \
MR_XCOMMON(tvt, tvc))
-#define MR_DEF_LLTXCC0_S(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc) \
+#define MR_DEF_LLTXCC0_U(e, ln, port, num, path, vc, ltt, ltc, vnt, vnc) \
MR_DEF_LL_GEN(e, ln, port, MR_TRUE, num, path, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
vc, \
MR_XCOMMON(ltt, ltc), \
MR_XCOMMON(vnt, vnc), 0)
@@ -593,14 +592,14 @@
#define MR_DEF_LLNVIT(e, ln, port, num, path) \
MR_DEF_LLNVI_GEN(e, ln, port, NULL, MR_TRUE, path)
-#define MR_DEF_LLNVI_S(e, ln, port, num, path) \
+#define MR_DEF_LLNVI_U(e, ln, port, num, path) \
MR_DEF_LLNVI_GEN(e, ln, port, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
MR_FALSE, path)
-#define MR_DEF_LLNVIT_S(e, ln, port, num, path) \
+#define MR_DEF_LLNVIT_U(e, ln, port, num, path) \
MR_DEF_LLNVI_GEN(e, ln, port, \
- MR_SOLVER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
+ &MR_USER_LAYOUT_NAME(MR_label_name(MR_add_prefix(e), ln)), \
MR_TRUE, path)
#define MR_DECL_LL(e, ln) \
@@ -1291,6 +1290,19 @@
const MR_Label_Layout **MR_mfl_label_layout;
} MR_Module_File_Layout;
+/*
+** The version of the data structures in this file -- useful for bootstrapping.
+** If you write runtime code that checks this version number and can at least
+** handle the previous version of the data structure, it makes it easier to
+** bootstrap changes to these data structures.
+**
+** This number should be kept in sync with layout_version_number in
+** compiler/layout_out.m.
+*/
+
+#define MR_LAYOUT_VERSION MR_LAYOUT_VERSION__USER_DEFINED
+#define MR_LAYOUT_VERSION__USER_DEFINED 1
+
struct MR_Module_Layout_Struct {
MR_uint_least8_t MR_ml_version_number;
MR_ConstString MR_ml_name;
@@ -1304,6 +1316,7 @@
MR_int_least32_t MR_ml_suppressed_events;
MR_int_least32_t MR_ml_num_label_exec_counts;
MR_Unsigned *MR_ml_label_exec_count;
+ const char *MR_ml_event_specs;
};
/*-------------------------------------------------------------------------*/
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.76
diff -u -b -r1.76 mercury_trace_base.c
--- runtime/mercury_trace_base.c 29 Sep 2006 06:34:55 -0000 1.76
+++ runtime/mercury_trace_base.c 18 Nov 2006 16:02:40 -0000
@@ -119,7 +119,7 @@
"SWTC",
"FRST",
"LATR",
- "SLVR",
+ "USER",
"NONE",
};
@@ -147,7 +147,7 @@
}
MR_Code *
-MR_solver_trace(const MR_Label_Layout *layout)
+MR_user_trace(const MR_Label_Layout *layout)
{
if (! MR_trace_func_enabled) {
return NULL;
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.55
diff -u -b -r1.55 mercury_trace_base.h
--- runtime/mercury_trace_base.h 29 Sep 2006 06:34:55 -0000 1.55
+++ runtime/mercury_trace_base.h 18 Nov 2006 14:37:37 -0000
@@ -46,7 +46,7 @@
MR_PORT_SWITCH,
MR_PORT_PRAGMA_FIRST,
MR_PORT_PRAGMA_LATER,
- MR_PORT_SOLVER,
+ MR_PORT_USER,
MR_PORT_NONE
} MR_Trace_Port;
@@ -102,7 +102,7 @@
extern MR_Code *MR_trace_fake(const MR_Label_Layout *);
extern MR_Code *MR_trace_count(const MR_Label_Layout *);
-extern MR_Code *MR_solver_trace(const MR_Label_Layout *);
+extern MR_Code *MR_user_trace(const MR_Label_Layout *);
/*
** These three variables implement a table of module layout structures,
@@ -578,7 +578,7 @@
#endif /* !MR_HIGHLEVEL_CODE */
/*
-** The compiler emits the following macro at each non-solver trace event.
+** The compiler emits the following macro at each system-defined trace event.
*/
#define MR_EVENT(label) \
@@ -592,14 +592,14 @@
}
/*
-** The compiler emits the following macro at each solver trace event.
+** The compiler emits the following macro at each user-defined trace event.
*/
-#define MR_SOLVER_EVENT(label) \
+#define MR_USER_EVENT(label) \
{ \
MR_Code *MR_jumpaddr; \
MR_save_transient_registers(); \
- MR_jumpaddr = MR_solver_trace((const MR_Label_Layout *) \
+ MR_jumpaddr = MR_user_trace((const MR_Label_Layout *) \
&MR_LABEL_LAYOUT_NAME(MR_add_prefix(label))); \
MR_restore_transient_registers(); \
if (MR_jumpaddr != NULL) MR_GOTO(MR_jumpaddr); \
Index: runtime/mercury_trace_term.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_term.c,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_trace_term.c
--- runtime/mercury_trace_term.c 1 Feb 2005 03:24:26 -0000 1.1
+++ runtime/mercury_trace_term.c 10 Nov 2006 01:36:47 -0000
@@ -42,8 +42,8 @@
if (str[i] == '"') {
term = MR_malloc(sizeof(struct MR_CTerm_Struct));
- term->term_functor = &str[0];
- term->term_args = NULL;
+ term->MR_term_functor = &str[0];
+ term->MR_term_args = NULL;
*rest = &str[i + 1];
return term;
}
@@ -63,20 +63,20 @@
term = MR_malloc(sizeof(struct MR_CTerm_Struct));
if ((str[i] == '\0') || str[i] == ',' || str[i] == ')') {
- term->term_functor = str;
- term->term_args = NULL;
+ term->MR_term_functor = str;
+ term->MR_term_args = NULL;
*rest = &str[i];
return term;
} else if (str[i] == '(') {
str[i] = '\0';
- term->term_functor = str;
+ term->MR_term_functor = str;
args = MR_create_cargs(&str[i + 1], rest);
if (args == NULL) {
MR_free(term);
return NULL;
}
- term->term_args = args;
+ term->MR_term_args = args;
return term;
}
@@ -99,11 +99,11 @@
}
args = MR_malloc(sizeof(struct MR_CArgs_Struct));
- args->args_head = term;
+ args->MR_args_head = term;
if (more[0] == ')') {
more[0] = '\0'; /* to terminate the just previous functor, if any */
- args->args_tail = NULL;
+ args->MR_args_tail = NULL;
*rest = &more[1];
return args;
} else if (more[0] == ',') {
@@ -124,7 +124,7 @@
return NULL;
}
- args->args_tail = tail;
+ args->MR_args_tail = tail;
return args;
}
@@ -138,17 +138,17 @@
MR_CArgs args;
int i;
- fprintf(fp, "%s", term->term_functor);
- if (term->term_args != NULL) {
+ fprintf(fp, "%s", term->MR_term_functor);
+ if (term->MR_term_args != NULL) {
fprintf(fp, "(");
i = 0;
- args = term->term_args;
+ args = term->MR_term_args;
while (args != NULL) {
if (i > 0) {
fprintf(fp, ", ");
}
- MR_print_cterm(fp, args->args_head);
- args = args->args_tail;
+ MR_print_cterm(fp, args->MR_args_head);
+ args = args->MR_args_tail;
i++;
}
fprintf(fp, ")");
@@ -159,7 +159,7 @@
MR_delete_cterm(MR_CTerm term)
{
if (term != NULL) {
- MR_delete_cargs(term->term_args);
+ MR_delete_cargs(term->MR_term_args);
MR_free(term);
}
}
@@ -168,8 +168,8 @@
MR_delete_cargs(MR_CArgs args)
{
if (args != NULL) {
- MR_delete_cargs(args->args_tail);
- MR_delete_cterm(args->args_head);
+ MR_delete_cargs(args->MR_args_tail);
+ MR_delete_cterm(args->MR_args_head);
MR_free(args);
}
}
Index: runtime/mercury_trace_term.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_term.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_trace_term.h
--- runtime/mercury_trace_term.h 1 Feb 2005 04:03:57 -0000 1.1
+++ runtime/mercury_trace_term.h 10 Nov 2006 06:32:24 -0000
@@ -17,14 +17,27 @@
typedef struct MR_CTerm_Struct *MR_CTerm;
typedef struct MR_CArgs_Struct *MR_CArgs;
+typedef struct MR_FlatTerm_Struct *MR_FlatTerm;
+typedef struct MR_FlatArgs_Struct *MR_FlatArgs;
+
struct MR_CTerm_Struct {
- char *term_functor;
- MR_CArgs term_args;
+ char *MR_term_functor;
+ MR_CArgs MR_term_args;
};
struct MR_CArgs_Struct {
- MR_CTerm args_head;
- MR_CArgs args_tail;
+ MR_CTerm MR_args_head;
+ MR_CArgs MR_args_tail;
+};
+
+struct MR_FlatTerm_Struct {
+ char *MR_flat_term_functor;
+ MR_FlatArgs MR_flat_term_args;
+};
+
+struct MR_FlatArgs_Struct {
+ char *MR_flat_args_head;
+ MR_FlatArgs MR_flat_args_tail;
};
/*
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_types.h,v
retrieving revision 1.45
diff -u -b -r1.45 mercury_types.h
--- runtime/mercury_types.h 29 Sep 2006 06:34:55 -0000 1.45
+++ runtime/mercury_types.h 18 Nov 2006 14:12:27 -0000
@@ -233,7 +233,7 @@
typedef struct MR_Proc_Layout_Struct MR_Proc_Layout;
typedef struct MR_Module_Layout_Struct MR_Module_Layout;
typedef struct MR_Label_Layout_Struct MR_Label_Layout;
-typedef struct MR_Solver_Event_Struct MR_Solver_Event;
+typedef struct MR_UserEvent_Struct MR_UserEvent;
typedef union MR_TableNode_Union MR_TableNode;
typedef MR_TableNode *MR_TrieNode;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: [05:18:44] waiting for uid20308's lock in /home/mercury/mercury1/repository/mercury/samples
cvs diff: [05:19:14] obtained lock in /home/mercury/mercury1/repository/mercury/samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
Index: scripts/c2init.in
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/c2init.in,v
retrieving revision 1.47
diff -u -b -r1.47 c2init.in
--- scripts/c2init.in 24 Feb 2006 07:11:21 -0000 1.47
+++ scripts/c2init.in 12 Nov 2006 08:24:06 -0000
@@ -51,6 +51,7 @@
RT_LIB_NAME=mer_rt
STD_LIB_NAME=mer_std
TRACE_LIB_NAME=mer_trace
+EVENTSPEC_LIB_NAME=mer_eventspec
BROWSER_LIB_NAME=mer_browser
MDBCOMP_LIB_NAME=mer_mdbcomp
ANALYSIS_LIB_NAME=mer_analysis
Index: scripts/ml.in
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/ml.in,v
retrieving revision 1.117
diff -u -b -r1.117 ml.in
--- scripts/ml.in 2 Oct 2006 09:06:51 -0000 1.117
+++ scripts/ml.in 12 Nov 2006 08:57:04 -0000
@@ -96,6 +96,7 @@
RT_LIB_NAME=mer_rt
STD_LIB_NAME=mer_std
TRACE_LIB_NAME=mer_trace
+EVENTSPEC_LIB_NAME=mer_eventspec
BROWSER_LIB_NAME=mer_browser
MDBCOMP_LIB_NAME=mer_mdbcomp
@@ -222,13 +223,15 @@
esac
case $trace in
- true) TRACE_LIBS="-l$TRACE_LIB_NAME -l$BROWSER_LIB_NAME \
- -l$MDBCOMP_LIB_NAME"
+ true) TRACE_LIBS="-l$TRACE_LIB_NAME -l$EVENTSPEC_LIB_NAME \
+ -l$BROWSER_LIB_NAME -l$MDBCOMP_LIB_NAME"
TRACE_LIBS_SYSTEM="$TRACE_LIBS_SYSTEM $READLINE_LIBRARIES"
TRACE_STATIC_LIBS="\
`$FIX_PATH_FOR_LINKER \
$LIBDIR/$GRADE/lib$TRACE_LIB_NAME. at LIB_SUFFIX@` \
`$FIX_PATH_FOR_LINKER \
+ $LIBDIR/$GRADE/lib$EVENTSPEC_LIB_NAME. at LIB_SUFFIX@` \
+ `$FIX_PATH_FOR_LINKER \
$LIBDIR/$GRADE/lib$BROWSER_LIB_NAME. at LIB_SUFFIX@` \
`$FIX_PATH_FOR_LINKER \
$LIBDIR/$GRADE/lib$MDBCOMP_LIB_NAME. at LIB_SUFFIX@`"
Index: scripts/prepare_tmp_dir_grade_part
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/prepare_tmp_dir_grade_part,v
retrieving revision 1.5
diff -u -b -r1.5 prepare_tmp_dir_grade_part
--- scripts/prepare_tmp_dir_grade_part 22 Aug 2006 14:42:58 -0000 1.5
+++ scripts/prepare_tmp_dir_grade_part 20 Nov 2006 02:14:27 -0000
@@ -39,7 +39,7 @@
mkdir tmp_dir/trace
cp trace/Mmake* tmp_dir/trace
cp trace/.mgnuc* tmp_dir/trace
-cp trace/*.[ch] tmp_dir/trace
+cp trace/*.[chyl] tmp_dir/trace
mkdir tmp_dir/library
cp library/Mmake* tmp_dir/library
cp library/Mercury.* tmp_dir/library
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mercury.options,v
retrieving revision 1.18
diff -u -b -r1.18 Mercury.options
--- tests/debugger/Mercury.options 8 Jun 2006 08:20:07 -0000 1.18
+++ tests/debugger/Mercury.options 18 Nov 2006 16:51:05 -0000
@@ -41,6 +41,8 @@
# asm_fast.gc.debug.tr.
MCFLAGS-uci_index = --compare-specialization 2 --intermodule-optimization
+MCFLAGS-user_event = --event-spec-file-name user_event_spec
+
# The solver_test test case exercises the printing of a procedure name, and
# that procedure is dead, so we must prevent it being optimized away.
# The -O2 is to prevent spurious inconsistencies.
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.126
diff -u -b -r1.126 Mmakefile
--- tests/debugger/Mmakefile 2 Oct 2006 05:21:42 -0000 1.126
+++ tests/debugger/Mmakefile 19 Nov 2006 14:58:17 -0000
@@ -51,7 +51,8 @@
save \
solver_test \
type_desc_test \
- uci_index
+ uci_index \
+ user_event
# We currently don't pass this test.
# deeply_nested_typeinfo
@@ -526,6 +527,9 @@
uci_index.out: uci_index uci_index.inp
$(MDB_STD) ./uci_index < uci_index.inp 2>&1 > uci_index.out 2>&1
+user_event.out: user_event user_event.inp
+ $(MDB_STD) ./user_event < user_event.inp 2>&1 > user_event.out 2>&1
+
# When WORKSPACE is set, use $(WORKSPACE)/tools/lmc to compile the query.
ifneq ($(origin WORKSPACE), undefined)
export WORKSPACE
Index: tests/debugger/completion.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/completion.exp,v
retrieving revision 1.33
diff -u -b -r1.33 completion.exp
--- tests/debugger/completion.exp 13 Jun 2006 09:49:01 -0000 1.33
+++ tests/debugger/completion.exp 18 Nov 2006 18:45:34 -0000
@@ -34,13 +34,13 @@
diff mmc_options unhide_events
disable modules untrust
document next up
-document_category nondet_stack v
-down open var_details
-dump p vars
-e pass_trace_counts view
-echo pneg_stack xml_browser_cmd
-enable pop_list_dir xml_tmp_filename
-exception print
+document_category nondet_stack user
+down open v
+dump p var_details
+e pass_trace_counts vars
+echo pneg_stack view
+enable pop_list_dir xml_browser_cmd
+exception print xml_tmp_filename
excp print_optionals
h help histogram_exp
held_vars histogram_all hold
Index: tests/debugger/mdb_command_test.inp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/mdb_command_test.inp,v
retrieving revision 1.51
diff -u -b -r1.51 mdb_command_test.inp
--- tests/debugger/mdb_command_test.inp 13 Jun 2006 09:49:01 -0000 1.51
+++ tests/debugger/mdb_command_test.inp 19 Nov 2006 16:55:02 -0000
@@ -28,6 +28,7 @@
finish xyzzy xyzzy xyzzy xyzzy xyzzy
exception xyzzy xyzzy xyzzy xyzzy xyzzy
return xyzzy xyzzy xyzzy xyzzy xyzzy
+user xyzzy xyzzy xyzzy xyzzy xyzzy
forward xyzzy xyzzy xyzzy xyzzy xyzzy
mindepth xyzzy xyzzy xyzzy xyzzy xyzzy
maxdepth xyzzy xyzzy xyzzy xyzzy xyzzy
Index: tests/debugger/user_event.exp
===================================================================
RCS file: tests/debugger/user_event.exp
diff -N tests/debugger/user_event.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/user_event.exp 19 Nov 2006 14:58:25 -0000
@@ -0,0 +1,57 @@
+ E1: C1 CALL pred user_event.main/2-0 (cc_multi) user_event.m:16
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> user
+ E2: C2 USER pred user_event.queen/2-0 (nondet) c3; user_event.m:32
+mdb> print *
+ test_list (attr 0) [1, 2, 3, 4, 5]
+ Data (arg 1) [1, 2, 3, 4, 5]
+ Out (arg 2) [1, 2, 3, 4, 5]
+mdb> browse !test_list
+browser> p
+[1, 2, 3, 4, 5]
+browser> ^2^1
+browser> p
+2
+browser> quit
+mdb> user
+ E3: C3 USER pred user_event.nodiag/3-0 (semidet) s2;c6;t;c2; user_event.m:64
+mdb> vars
+ 1 test_failed (attr 0)
+ 2 arg_b (attr 1)
+ 3 arg_d (attr 2)
+ 4 arg_list (attr 3)
+ 5 HeadVar__1
+ 6 HeadVar__2
+ 7 HeadVar__3
+ 8 B
+ 9 BmN
+ 10 D
+ 11 L
+ 12 N
+ 13 NmB
+mdb> print *
+ test_failed (attr 0) "N - B"
+ arg_b (attr 1) 1
+ arg_d (attr 2) 2
+ arg_list (attr 3) [2, 3, 4, 5]
+ HeadVar__1 1
+ HeadVar__2 1
+ HeadVar__3 [2, 3, 4, 5]
+ B 1
+ BmN -1
+ D 1
+ L [3, 4, 5]
+ N 2
+ NmB 1
+mdb> print !arg_b
+ arg_b (attr 1) 1
+mdb> user
+ E4: C2 USER pred user_event.queen/2-0 (nondet) c3; user_event.m:32
+mdb> print *
+ test_list (attr 0) [1, 2, 3, 5, 4]
+ Data (arg 1) [1, 2, 3, 4, 5]
+ Out (arg 2) [1, 2, 3, 5, 4]
+mdb> continue
+[1, 3, 5, 2, 4]
Index: tests/debugger/user_event.inp
===================================================================
RCS file: tests/debugger/user_event.inp
diff -N tests/debugger/user_event.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/user_event.inp 19 Nov 2006 14:58:23 -0000
@@ -0,0 +1,16 @@
+echo on
+register --quiet
+user
+print *
+browse !test_list
+p
+^2^1
+p
+quit
+user
+vars
+print *
+print !arg_b
+user
+print *
+continue
Index: tests/debugger/user_event.m
===================================================================
RCS file: tests/debugger/user_event.m
diff -N tests/debugger/user_event.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/user_event.m 19 Nov 2006 14:51:07 -0000
@@ -0,0 +1,99 @@
+:- module user_event.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module list.
+:- import_module int.
+
+:- type listint == list(int).
+
+main(!IO) :-
+ data(Data),
+ ( queen(Data, Out) ->
+ print_list(Out, !IO)
+ ;
+ io.write_string("No solution\n", !IO)
+ ).
+
+:- pred data(list(int)::out) is det.
+
+data([1,2,3,4,5]).
+
+:- pred queen(list(int)::in, list(int)::out) is nondet.
+
+queen(Data, Out) :-
+ qperm(Data, Out),
+ event safe_test(Out),
+ safe(Out).
+
+:- pred qperm(list(T)::in, list(T)::out) is nondet.
+
+qperm([], []).
+qperm(L, K) :-
+ L = [_ | _],
+ qdelete(U, L, Z),
+ K = [U | V],
+ qperm(Z, V).
+
+:- pred qdelete(T::out, list(T)::in, list(T)::out) is nondet.
+
+qdelete(A, [A | L], L).
+qdelete(X, [A | Z], [A | R]) :-
+ qdelete(X, Z, R).
+
+:- pred safe(list(int)::in) is semidet.
+
+safe([]).
+safe([N | L]) :-
+ nodiag(N, 1, L),
+ safe(L).
+
+:- pred nodiag(int::in, int::in, list(int)::in) is semidet.
+
+nodiag(_, _, []).
+nodiag(B, D, [N | L]) :-
+ NmB = N - B,
+ BmN = B - N,
+ ( D = NmB ->
+ event nodiag_fail("N - B", B, N, [N | L]),
+ fail
+ ; D = BmN ->
+ event nodiag_fail("B - N", B, N, [N | L]),
+ fail
+ ;
+ true
+ ),
+ D1 = D + 1,
+ nodiag(B, D1, L).
+
+:- pred print_list(list(int)::in, io::di, io::uo) is det.
+
+print_list(Xs, !IO) :-
+ (
+ Xs = [],
+ io.write_string("[]\n", !IO)
+ ;
+ Xs = [_ | _],
+ io.write_string("[", !IO),
+ print_list_2(Xs, !IO),
+ io.write_string("]\n", !IO)
+ ).
+
+:- pred print_list_2(list(int)::in, io::di, io::uo) is det.
+
+print_list_2([], !IO).
+print_list_2([X | Xs], !IO) :-
+ io.write_int(X, !IO),
+ (
+ Xs = []
+ ;
+ Xs = [_ | _],
+ io__write_string(", ", !IO),
+ print_list_2(Xs, !IO)
+ ).
Index: tests/debugger/user_event_spec
===================================================================
RCS file: tests/debugger/user_event_spec
diff -N tests/debugger/user_event_spec
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/user_event_spec 19 Nov 2006 02:10:00 -0000
@@ -0,0 +1,10 @@
+event nodiag_fail(
+ test_failed: string,
+ arg_b: int,
+ arg_d: int,
+ arg_list: list(int)
+)
+
+event safe_test(
+ test_list: listint
+)
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: [05:19:22] waiting for uid20308's lock in /home/mercury/mercury1/repository/tests/hard_coded
cvs diff: [05:19:52] obtained lock in /home/mercury/mercury1/repository/tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: [05:19:55] waiting for uid20308's lock in /home/mercury/mercury1/repository/tests/invalid
cvs diff: [05:20:25] obtained lock in /home/mercury/mercury1/repository/tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: [05:20:27] waiting for uid20308's lock in /home/mercury/mercury1/repository/tests/mmc_make/lib
cvs diff: [05:20:57] obtained lock in /home/mercury/mercury1/repository/tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: [05:20:59] waiting for uid20308's lock in /home/mercury/mercury1/repository/tests/tabling
cvs diff: [05:21:29] obtained lock in /home/mercury/mercury1/repository/tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: [05:21:30] waiting for uid20308's lock in /home/mercury/mercury1/repository/tests/valid
cvs diff: [05:22:00] obtained lock in /home/mercury/mercury1/repository/tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
Index: tools/bootcheck
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/bootcheck,v
retrieving revision 1.188
diff -u -b -r1.188 bootcheck
--- tools/bootcheck 3 Nov 2006 08:31:22 -0000 1.188
+++ tools/bootcheck 17 Nov 2006 03:57:17 -0000
@@ -709,6 +709,7 @@
cd trace
$LN_S $root/trace/*.h .
$LN_S $root/trace/*.c .
+ $LN_S $root/trace/*.[yl] .
cp $root/trace/Mmake* .
cp $root/trace/.mgnu* .
$LN_S $root/trace/RESERVED_MACRO_NAMES .
Index: tools/lmc.in
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/lmc.in,v
retrieving revision 1.8
diff -u -b -r1.8 lmc.in
--- tools/lmc.in 3 Oct 2005 06:29:18 -0000 1.8
+++ tools/lmc.in 18 Nov 2006 16:00:29 -0000
@@ -93,7 +93,8 @@
echo "$WORKSPACE/boehm_gc does not have a gc library"
fi
-LIB_FLAGS="--link-object $WORKSPACE/trace/libmer_trace.$O --link-object $WORKSPACE/browser/libmer_browser.$O --link-object $WORKSPACE/mdbcomp/libmer_mdbcomp.$O --link-object $WORKSPACE/library/libmer_std.$O --link-object $WORKSPACE/runtime/libmer_rt.$O --link-object $gclib -lm @TRACE_LIBS_SYSTEM@ @READLINE_LIBRARIES@"
+LIB_FLAGS="--link-object $WORKSPACE/trace/libmer_trace.$O --link-object
+$WORKSPACE/trace/libmer_eventspec.$O --link-object $WORKSPACE/browser/libmer_browser.$O --link-object $WORKSPACE/mdbcomp/libmer_mdbcomp.$O --link-object $WORKSPACE/library/libmer_std.$O --link-object $WORKSPACE/runtime/libmer_rt.$O --link-object $gclib -lm @TRACE_LIBS_SYSTEM@ @READLINE_LIBRARIES@"
INIT_FLAGS="--trace-init-file $WORKSPACE/browser/mer_browser.init --trace-init-file $WORKSPACE/mdbcomp/mer_mdbcomp.init --init-file $WORKSPACE/library/mer_std.init --init-file $WORKSPACE/runtime/mer_rt.init"
cvs diff: Diffing trace
Index: trace/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/Mmakefile,v
retrieving revision 1.46
diff -u -b -r1.46 Mmakefile
--- trace/Mmakefile 15 Nov 2006 08:24:43 -0000 1.46
+++ trace/Mmakefile 19 Nov 2006 02:22:20 -0000
@@ -9,8 +9,9 @@
#-----------------------------------------------------------------------------#
-# keep this list in alphabetical order, please
-HDRS = \
+# The list of human-written C header files of the trace library.
+# Keep this list in alphabetical order, please.
+HAND_TRACE_HDRS = \
mercury_trace_alias.h \
mercury_trace_browse.h \
mercury_trace_cmd_backward.h \
@@ -39,8 +40,9 @@
mercury_trace_util.h \
mercury_trace_vars.h
-# keep this list in alphabetical order, please
-CFILES = \
+# The list of human-written C source files of the trace library.
+# Keep this list in alphabetical order, please.
+HAND_TRACE_SRCS = \
mercury_trace_alias.c \
mercury_trace_browse.c \
mercury_trace.c \
@@ -69,6 +71,39 @@
mercury_trace_util.c \
mercury_trace_vars.c
+# The list of human-written C header files of the eventspec library.
+# Keep this list in alphabetical order, please.
+HAND_EVENTSPEC_HDRS = \
+ mercury_event_spec.h
+
+# The list of human-written C source files of the eventspec library.
+# Keep this list in alphabetical order, please.
+HAND_EVENTSPEC_SRCS = \
+ mercury_event_spec.c
+
+# The list of automatically created C header files.
+# Keep this list in alphabetical order, please.
+GEN_EVENTSPEC_HDRS = \
+ mercury_event_parser.h
+
+# The list of automatically created C source files.
+# Keep this list in alphabetical order, please.
+GEN_EVENTSPEC_SRCS = \
+ mercury_event_parser.c \
+ mercury_event_scanner.c
+
+TRACE_HDRS = $(HAND_TRACE_HDRS)
+TRACE_SRCS = $(HAND_TRACE_SRCS)
+
+EVENTSPEC_HDRS = $(HAND_EVENTSPEC_HDRS) $(GEN_EVENTSPEC_HDRS)
+EVENTSPEC_SRCS = $(HAND_EVENTSPEC_SRCS) $(GEN_EVENTSPEC_SRCS)
+
+HAND_HDRS = $(HAND_TRACE_HDRS) $(HAND_EVENTSPEC_HDRS)
+HAND_SRCS = $(HAND_TRACE_SRCS) $(HAND_EVENTSPEC_SRCS)
+
+HDRS = $(TRACE_HDRS) $(EVENTSPEC_HDRS)
+SRCS = $(TRACE_SRCS) $(EVENTSPEC_SRCS)
+
# The object files in this directory depend on many of the header files
# in the runtime. However, changes to many of these header files require
# a global make clean. Here we list only the header files from the runtime
@@ -77,14 +112,22 @@
RUNTIME_HDRS = \
$(RUNTIME_DIR)/mercury_stack_layout.h
-OBJS = $(CFILES:.c=.$O)
-PIC_OBJS = $(CFILES:.c=.$(EXT_FOR_PIC_OBJECTS))
+TRACE_OBJS = $(TRACE_SRCS:.c=.$O)
+EVENTSPEC_OBJS = $(EVENTSPEC_SRCS:.c=.$O)
+OBJS = $(SRCS:.c=.$O)
+TRACE_PIC_OBJS = $(TRACE_SRCS:.c=.$(EXT_FOR_PIC_OBJECTS))
+EVENTSPEC_PIC_OBJS = $(EVENTSPEC_SRCS:.c=.$(EXT_FOR_PIC_OBJECTS))
+PIC_OBJS = $(SRCS:.c=.$(EXT_FOR_PIC_OBJECTS))
-LDFLAGS = -L$(BROWSER_DIR) -L$(MDBCOMP_DIR) -L$(LIBRARY_DIR) \
+EVENTSPEC_LDFLAGS = -L$(BROWSER_DIR) -L$(MDBCOMP_DIR) -L$(LIBRARY_DIR) \
-L$(RUNTIME_DIR) -L$(BOEHM_GC_DIR) -L/usr/local/lib
-LDLIBS = -l$(BROWSER_LIB_NAME) -l$(MDBCOMP_LIB_NAME) \
+EVENTSPEC_LDLIBS= -l$(BROWSER_LIB_NAME) -l$(MDBCOMP_LIB_NAME) \
$(MLLIBS) $(SOCKET_LIBRARY) \
$(NSL_LIBRARY) $(DL_LIBRARY) $(READLINE_LIBRARIES)
+
+TRACE_LDFLAGS = -L$(TRACE_DIR) $(EVENTSPEC_LDFLAGS)
+TRACE_LDLIBS = -l$(EVENTSPEC_LIB_NAME) $(EVENTSPEC_LDLIBS)
+
THREADLIBS = \
` case "$(GRADE)" in \
*.par*) echo "-lpthread" ;; \
@@ -94,14 +137,23 @@
# Specify which files to check for namespace cleanliness, and which name
# prefixes are allowed.
+#
+# The header files generated by flex and bison cannot pass any kind of
+# namespace cleanliness test, and we don't have enough control over them
+# to make them pass those tests.
-CHECK_HDRS = $(HDRS)
+CHECK_HDRS = $(HAND_HDRS)
CHECK_MHDRS =
CHECK_OBJS = $(OBJS)
ALLOW_LIB_PREFIX=no
ALLOW_BROWSER_PREFIX=no
ALLOW_MDBCOMP_PREFIX=no
+BISON = bison
+BISON_OPTS = -v
+FLEX = flex
+FLEX_OPTS = --8bit
+
MERCURY_DIR=..
LINK_STDLIB_ONLY=yes
include $(MERCURY_DIR)/Mmake.common
@@ -147,7 +199,15 @@
#-----------------------------------------------------------------------------#
-$(OBJS) $(PIC_OBJS): $(HDRS) $(RUNTIME_HDRS)
+# Most object files do not depend on the automatically generated headers;
+# for the ones that do, we list the dependency explicitly.
+
+$(OBJS) $(PIC_OBJS): $(HAND_HDRS) $(RUNTIME_HDRS)
+
+mercury_event_scanner.$(O): $(GEN_EVENTSPEC_HDRS)
+mercury_event_scanner.$(EXT_FOR_PIC_OBJECTS): $(GEN_EVENTSPEC_HDRS)
+mercury_event_parser.$(O): $(GEN_EVENTSPEC_HDRS)
+mercury_event_parser.$(EXT_FOR_PIC_OBJECTS): $(GEN_EVENTSPEC_HDRS)
#-----------------------------------------------------------------------------#
@@ -164,45 +224,86 @@
all: trace $(TAGS_FILE_EXISTS)
-trace: lib$(TRACE_LIB_NAME).$A lib$(TRACE_LIB_NAME).$(EXT_FOR_SHARED_LIB)
+trace: lib$(EVENTSPEC_LIB_NAME).$A
+trace: lib$(EVENTSPEC_LIB_NAME).$(EXT_FOR_SHARED_LIB)
+trace: lib$(TRACE_LIB_NAME).$A
+trace: lib$(TRACE_LIB_NAME).$(EXT_FOR_SHARED_LIB)
trace: $(LIB_DLL_H) $(LIB_GLOBALS_H)
endif
-lib$(TRACE_LIB_NAME)$(DLL_DEF_LIB).$A: $(OBJS)
+mercury_event_parser.c mercury_event_parser.h: mercury_event_parser.y
+ $(BISON) $(BISON_OPTS) -p mercury_event_ -d -o mercury_event_parser.c \
+ mercury_event_parser.y
+
+mercury_event_scanner.c mercury_event_scanner.h: \
+ mercury_event_scanner.l mercury_event_parser.h
+ $(FLEX) $(FLEX_OPTS) -s -P mercury_event_ \
+ -o mercury_event_scanner.c \
+ --header-file=mercury_event_scanner.h \
+ mercury_event_scanner.l
+
+RPATH_1=$(SHLIB_RPATH_OPT)$(FINAL_INSTALL_MERC_LIB_DIR)
+RPATH_2=$(SHLIB_RPATH_SEP)$(FINAL_INSTALL_MERC_GC_LIB_DIR)
+
+lib$(TRACE_LIB_NAME)$(DLL_DEF_LIB).$A: \
+ $(TRACE_OBJS) lib$(EVENTSPEC_LIB_NAME)$(DLL_DEF_LIB).$A
rm -f lib$(TRACE_LIB_NAME)$(DLL_DEF_LIB).$A
$(AR) $(ALL_ARFLAGS) \
- $(AR_LIBFILE_OPT)lib$(TRACE_LIB_NAME)$(DLL_DEF_LIB).$A $(OBJS)
+ $(AR_LIBFILE_OPT)lib$(TRACE_LIB_NAME)$(DLL_DEF_LIB).$A \
+ $(TRACE_OBJS)
$(RANLIB) $(RANLIBFLAGS) lib$(TRACE_LIB_NAME)$(DLL_DEF_LIB).$A
-RPATH_1=$(SHLIB_RPATH_OPT)$(FINAL_INSTALL_MERC_LIB_DIR)
-RPATH_2=$(SHLIB_RPATH_SEP)$(FINAL_INSTALL_MERC_GC_LIB_DIR)
+lib$(EVENTSPEC_LIB_NAME)$(DLL_DEF_LIB).$A: $(EVENTSPEC_OBJS)
+ rm -f lib$(EVENTSPEC_LIB_NAME)$(DLL_DEF_LIB).$A
+ $(AR) $(ALL_ARFLAGS) \
+ $(AR_LIBFILE_OPT)lib$(EVENTSPEC_LIB_NAME)$(DLL_DEF_LIB).$A \
+ $(EVENTSPEC_OBJS)
+ $(RANLIB) lib$(EVENTSPEC_LIB_NAME)$(DLL_DEF_LIB).$A
+
+lib$(TRACE_LIB_NAME).so: $(TRACE_PIC_OBJS) lib$(EVENTSPEC_LIB_NAME).so
+ $(LINK_SHARED_OBJ) $(ERROR_UNDEFINED) \
+ -o lib$(TRACE_LIB_NAME).so $(TRACE_PIC_OBJS) \
+ $(RPATH_1)$(RPATH_2) \
+ $(TRACE_LDFLAGS) $(TRACE_LDLIBS) $(THREADLIBS) \
+ $(SHARED_LIBS)
-lib$(TRACE_LIB_NAME).so: $(PIC_OBJS)
+lib$(EVENTSPEC_LIB_NAME).so: $(EVENTSPEC_PIC_OBJS)
$(LINK_SHARED_OBJ) $(ERROR_UNDEFINED) \
- -o lib$(TRACE_LIB_NAME).so $(PIC_OBJS) \
+ -o lib$(TRACE_LIB_NAME).so $(EVENTSPEC_PIC_OBJS) \
$(RPATH_1)$(RPATH_2) \
- $(LDFLAGS) $(LDLIBS) $(THREADLIBS) \
+ $(EVENTSPEC_LDFLAGS) $(EVENTSPEC_LDLIBS) $(THREADLIBS) \
$(SHARED_LIBS)
# For Darwin:
-lib$(TRACE_LIB_NAME).dylib: $(PIC_OBJS)
+lib$(TRACE_LIB_NAME).dylib: $(TRACE_PIC_OBJS) lib$(EVENTSPEC_LIB_NAME).dylib
+ $(LINK_SHARED_OBJ) $(ERROR_UNDEFINED) \
+ -o lib$(TRACE_LIB_NAME).dylib $(TRACE_PIC_OBJS) \
+ -install_name \
+ $(FINAL_INSTALL_MERC_LIB_DIR)/lib$(TRACE_LIB_NAME).dylib \
+ $(TRACE_LDFLAGS) $(TRACE_LDLIBS) $(THREADLIBS) \
+ $(SHARED_LIBS)
+
+lib$(EVENTSPEC_LIB_NAME).dylib: $(EVENTSPEC_PIC_OBJS)
$(LINK_SHARED_OBJ) $(ERROR_UNDEFINED) \
- -o lib$(TRACE_LIB_NAME).dylib $(PIC_OBJS) \
- -install_name $(FINAL_INSTALL_MERC_LIB_DIR)/lib$(TRACE_LIB_NAME).dylib \
- $(LDFLAGS) $(LDLIBS) $(THREADLIBS) \
+ -o lib$(EVENTSPEC_LIB_NAME).dylib $(EVENTSPEC_PIC_OBJS) \
+ -install_name \
+ $(FINAL_INSTALL_MERC_LIB_DIR)/lib$(EVENTSPEC_LIB_NAME).dylib \
+ $(EVENTSPEC_LDFLAGS) $(EVENTSPEC_LDLIBS) $(THREADLIBS) \
$(SHARED_LIBS)
.PHONY: cs
-cs: $(CFILES)
+cs: $(SRCS)
-tags: $(CFILES) $(HDRS)
- ctags $(CFILES) $(HDRS) $(RUNTIME_DIR)/*.c $(RUNTIME_DIR)/*.h
+tags: $(HAND_SRCS) $(HAND_HDRS)
+ ctags $(HAND_SRCS) $(HAND_HDRS) $(RUNTIME_DIR)/*.c $(RUNTIME_DIR)/*.h
.PHONY: tags_file_exists
tags_file_exists:
@if test ! -f tags; then echo making tags; \
- ctags $(CFILES) $(HDRS) $(RUNTIME_DIR)/*.c $(RUNTIME_DIR)/*.h ; fi
+ ctags $(HAND_SRCS) $(HAND_HDRS) \
+ $(RUNTIME_DIR)/*.c $(RUNTIME_DIR)/*.h ; \
+ fi
#-----------------------------------------------------------------------------#
@@ -228,13 +329,23 @@
cp `vpath_find $(HDRS) $(LIB_GLOBALS_H)` $(INSTALL_INC_DIR)
.PHONY: install_lib
-install_lib: lib$(TRACE_LIB_NAME).$A lib$(TRACE_LIB_NAME).$(EXT_FOR_SHARED_LIB)
+install_lib: \
+ lib$(TRACE_LIB_NAME).$A \
+ lib$(TRACE_LIB_NAME).$(EXT_FOR_SHARED_LIB) \
+ lib$(EVENTSPEC_LIB_NAME).$A \
+ lib$(EVENTSPEC_LIB_NAME).$(EXT_FOR_SHARED_LIB)
-[ -d $(INSTALL_MERC_LIB_DIR) ] || mkdir -p $(INSTALL_MERC_LIB_DIR)
- cp `vpath_find lib$(TRACE_LIB_NAME).$A \
- lib$(TRACE_LIB_NAME).$(EXT_FOR_SHARED_LIB)` \
+ cp `vpath_find \
+ lib$(TRACE_LIB_NAME).$A \
+ lib$(TRACE_LIB_NAME).$(EXT_FOR_SHARED_LIB) \
+ lib$(EVENTSPEC_LIB_NAME).$A \
+ lib$(EVENTSPEC_LIB_NAME).$(EXT_FOR_SHARED_LIB) \
+ ` \
$(INSTALL_MERC_LIB_DIR)
$(RANLIB) $(RANLIBFLAGS) \
$(INSTALL_MERC_LIB_DIR)/lib$(TRACE_LIB_NAME).$A
+ $(RANLIB) $(RANLIBFLAGS) \
+ $(INSTALL_MERC_LIB_DIR)/lib$(EVENTSPEC_LIB_NAME).$A
endif
Index: trace/mercury_event_parser.y
===================================================================
RCS file: trace/mercury_event_parser.y
diff -N trace/mercury_event_parser.y
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ trace/mercury_event_parser.y 19 Nov 2006 02:21:18 -0000
@@ -0,0 +1,240 @@
+%{
+/*
+** vim: ts=4 sw=4 et
+*/
+/*
+** Grammar for event set specifications.
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <string.h>
+
+#include "mercury_trace_term.h" /* for MR_CTerm and MR_FlatTerm */
+#include "mercury_memory.h" /* for MR_NEW */
+
+#include "mercury_event_spec.h" /* for MR_EventSpecs etc */
+#include "mercury_event_spec_missing.h" /* for mercury_event_text etc */
+#include "mercury_event_parser.h"
+#include "mercury_event_scanner.h" /* for mercury_event_lex etc */
+
+MR_EventSpecs mercury_event_parsetree;
+static unsigned mercury_event_next_num = 0;
+static void mercury_event_error(const char *s);
+%}
+
+%start file
+
+%union
+{
+ int Uline;
+ char *Uid;
+ MR_EventSpecs Uevents;
+ MR_EventSpec Uevent;
+ MR_EventAttrs Uattrs;
+ MR_EventAttr Uattr;
+ MR_CTerm Uterm;
+ MR_CArgs Uargs;
+ MR_FlatTerm Uflatterm;
+ MR_FlatArgs Uflatargs;
+ MR_EventAttrType Utype;
+}
+
+%token <Uline> TOKEN_EVENT
+%token TOKEN_FUNCTION
+%token TOKEN_SYNTHESIZED
+%token TOKEN_BY
+
+%token TOKEN_LPAREN
+%token TOKEN_RPAREN
+%token TOKEN_COLON
+%token TOKEN_COMMA
+
+%token <Uid> TOKEN_ID
+%token <Uid> TOKEN_SYM
+
+%token GARBAGE
+
+%type <Uevents> events
+%type <Uevent> event
+%type <Uattrs> maybe_attrs
+%type <Uattrs> attrs
+%type <Uattr> attr
+%type <Utype> type
+%type <Uterm> term
+%type <Uargs> terms
+%type <Uflatterm> flat_term
+%type <Uflatargs> ids
+%type <Uid> sym
+
+%%
+
+/**********************************************************************/
+
+file : events
+ {
+ mercury_event_parsetree = $1;
+ }
+ ;
+
+events : event events
+ {
+ $$ = MR_NEW(struct MR_EventSpecs_Struct);
+ $$->MR_events_head = $1;
+ $$->MR_events_tail = $2;
+ }
+ | /* empty */
+ {
+ $$ = NULL;
+ }
+ ;
+
+event : TOKEN_EVENT TOKEN_ID TOKEN_LPAREN maybe_attrs TOKEN_RPAREN
+ {
+ $$ = MR_NEW(struct MR_EventSpec_Struct);
+ $$->MR_event_num = mercury_event_next_num;
+ $$->MR_event_lineno = $1;
+ $$->MR_event_name = $2;
+ $$->MR_event_attributes = $4;
+ mercury_event_next_num++;
+ }
+ ;
+
+maybe_attrs : attrs
+ { $$ = $1; }
+ | /* empty */
+ { $$ = NULL; }
+ ;
+
+attrs : attr TOKEN_COMMA attrs
+ {
+ $$ = MR_NEW(struct MR_EventAttrs_Struct);
+ $$->MR_attrs_head = $1;
+ $$->MR_attrs_tail = $3;
+ }
+ | attr
+ {
+ $$ = MR_NEW(struct MR_EventAttrs_Struct);
+ $$->MR_attrs_head = $1;
+ $$->MR_attrs_tail = NULL;
+ }
+ ;
+
+attr : TOKEN_ID TOKEN_COLON type
+ {
+ $$ = MR_NEW(struct MR_EventAttr_Struct);
+ $$->MR_attr_name = $1;
+ $$->MR_attr_type = $3;
+ }
+ ;
+
+type : term
+ {
+ $$ = MR_NEW(struct MR_EventAttrType_Struct);
+ $$->MR_type_kind = MR_EVENT_ATTR_ORDINARY;
+ $$->MR_type_term = $1;
+ $$->MR_type_synth_call = NULL;
+ }
+ | TOKEN_FUNCTION
+ {
+ $$ = MR_NEW(struct MR_EventAttrType_Struct);
+ $$->MR_type_kind = MR_EVENT_ATTR_FUNCTION;
+ $$->MR_type_term = NULL;
+ $$->MR_type_synth_call = NULL;
+ }
+ | term TOKEN_SYNTHESIZED TOKEN_BY flat_term
+ {
+ $$ = MR_NEW(struct MR_EventAttrType_Struct);
+ $$->MR_type_kind = MR_EVENT_ATTR_SYNTHESIZED;
+ $$->MR_type_term = $1;
+ $$->MR_type_synth_call = $4;
+ }
+ ;
+
+term : sym
+ {
+ $$ = MR_NEW(struct MR_CTerm_Struct);
+ $$->MR_term_functor = $1;
+ $$->MR_term_args = NULL;
+ }
+ | sym TOKEN_LPAREN terms TOKEN_RPAREN
+ {
+ $$ = MR_NEW(struct MR_CTerm_Struct);
+ $$->MR_term_functor = $1;
+ $$->MR_term_args = $3;
+ }
+ ;
+
+terms : term TOKEN_COMMA terms
+ {
+ $$ = MR_NEW(struct MR_CArgs_Struct);
+ $$->MR_args_head = $1;
+ $$->MR_args_tail = $3;
+ }
+ | term
+ {
+ $$ = MR_NEW(struct MR_CArgs_Struct);
+ $$->MR_args_head = $1;
+ $$->MR_args_tail = NULL;
+ }
+ ;
+
+flat_term : TOKEN_ID
+ {
+ $$ = MR_NEW(struct MR_FlatTerm_Struct);
+ $$->MR_flat_term_functor = $1;
+ $$->MR_flat_term_args = NULL;
+ }
+ | TOKEN_ID TOKEN_LPAREN ids TOKEN_RPAREN
+ {
+ $$ = MR_NEW(struct MR_FlatTerm_Struct);
+ $$->MR_flat_term_functor = $1;
+ $$->MR_flat_term_args = $3;
+ }
+ ;
+
+ids : TOKEN_ID TOKEN_COMMA ids
+ {
+ $$ = MR_NEW(struct MR_FlatArgs_Struct);
+ $$->MR_flat_args_head = $1;
+ $$->MR_flat_args_tail = $3;
+ }
+ | TOKEN_ID
+ {
+ $$ = MR_NEW(struct MR_FlatArgs_Struct);
+ $$->MR_flat_args_head = $1;
+ $$->MR_flat_args_tail = NULL;
+ }
+ ;
+
+sym : TOKEN_ID
+ {
+ $$ = $1;
+ }
+ | TOKEN_SYM
+ {
+ $$ = $1;
+ }
+ ;
+
+%%
+
+static void
+mercury_event_error(const char *s)
+{
+ char buf[8192];
+
+ if (mercury_event_char <= 0) {
+ sprintf(buf, "premature EOF");
+ mercury_event_linenum--;
+ } else if (mercury_event_text[0] == '\n' || mercury_event_text[0] == '\f') {
+ sprintf(buf, "%s at end of line", s);
+ } else if (isprint(mercury_event_text[0])) {
+ sprintf(buf, "%s at symbol `%s'", s, mercury_event_text);
+ } else {
+ sprintf(buf, "%s at \\%o", s, mercury_event_text[0]);
+ }
+
+ printf("%s:%d: %s\n", mercury_event_filename, mercury_event_linenum, buf);
+}
Index: trace/mercury_event_scanner.l
===================================================================
RCS file: trace/mercury_event_scanner.l
diff -N trace/mercury_event_scanner.l
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ trace/mercury_event_scanner.l 19 Nov 2006 14:55:19 -0000
@@ -0,0 +1,128 @@
+%{
+/*
+** vim: ts=4 sw=4 et
+*/
+/*
+** Scanner for solver event specifications.
+*/
+
+#ifndef __USE_SVID
+#define __USE_SVID
+#endif
+#ifndef __USE_POSIX
+#define __USE_POSIX
+#endif
+#ifndef __USE_XOPEN_EXTENDED
+#define __USE_XOPEN_EXTENDED
+#endif
+#ifndef _GNU_SOURCE
+#define _GNU_SOURCE
+#endif
+#ifndef __EXTENSIONS__
+#define __EXTENSIONS__
+#endif
+
+#include <stdio.h>
+#include <string.h>
+#include "mercury_misc.h" /* for MR_fatal_error */
+#include "mercury_trace_term.h" /* for MR_Cterm etc */
+
+#include "mercury_event_spec.h"
+#include "mercury_event_spec_missing.h"
+#include "mercury_event_parser.h"
+
+/*
+** We should #include mercury_event_scanner.h as well, but flex puts into the
+** header file it creates a #undef for a macro it needs, so #including
+** mercury_event_scanner.h leads to compilation failure.
+*/
+
+#undef mercury_event_yywrap
+#define YY_NO_UNPUT
+#define YY_INPUT(buf, result, max_size) \
+ do { \
+ result = MR_event_get_input(buf, max_size); \
+ } while (0)
+
+extern void mercury_event_init(void);
+
+const char *mercury_event_filename = "no input file";
+int mercury_event_linenum = 0;
+
+/*
+** Add the declarations for local functions that flex is too lazy to add.
+**
+** These functions should be static, but flex defines them as non-static,
+** and we cannot declare them to be static without risking error messages
+** from mgnuc about mixing static declarations with non-static definitions.
+*/
+
+
+int mercury_event_get_lineno(void);
+FILE *mercury_event_get_in(void);
+FILE *mercury_event_get_out(void);
+int mercury_event_get_leng(void);
+char *mercury_event_get_text(void);
+void mercury_event_set_lineno(int line_number);
+void mercury_event_set_in(FILE *in_str);
+void mercury_event_set_out(FILE *out_str);
+int mercury_event_get_debug(void);
+void mercury_event_set_debug(int bdebug);
+int mercury_event_lex_destroy(void);
+%}
+
+alpha [a-zA-Z_]
+digit [0-9]
+alnum [a-zA-Z_0-9]
+sp [ \t]
+nl [\n\f]
+nonl [^\n\f]
+
+%pointer
+%option noyywrap
+
+%%
+
+"event" {
+ mercury_event_lval.Uline = mercury_event_linenum;
+ return TOKEN_EVENT;
+ }
+"function" { return TOKEN_FUNCTION; }
+"synthesized" { return TOKEN_SYNTHESIZED; }
+"by" { return TOKEN_BY; }
+
+"(" { return TOKEN_LPAREN; }
+")" { return TOKEN_RPAREN; }
+"," { return TOKEN_COMMA; }
+":" { return TOKEN_COLON; }
+
+{alpha}{alnum}* {
+ mercury_event_lval.Uid = strdup(yytext);
+ if (mercury_event_lval.Uid == NULL) {
+ MR_fatal_error("out of memory");
+ }
+
+ return TOKEN_ID;
+ }
+
+{alpha}{alnum}*("."{alpha}{alnum}*)* {
+ mercury_event_lval.Uid = strdup(yytext);
+ if (mercury_event_lval.Uid == NULL) {
+ MR_fatal_error("out of memory");
+ }
+
+ return TOKEN_SYM;
+ }
+
+"%"{nonl}*{nl} { mercury_event_linenum++; }
+
+{sp}+ {}
+{nl} { mercury_event_linenum++; }
+
+{nonl} { return GARBAGE; }
+
+%%
+
+void mercury_event_init(void)
+{
+}
Index: trace/mercury_event_spec.c
===================================================================
RCS file: trace/mercury_event_spec.c
diff -N trace/mercury_event_spec.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ trace/mercury_event_spec.c 19 Nov 2006 14:55:02 -0000
@@ -0,0 +1,236 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 1998-2002, 2005-2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This file contains the functions that we use to manipulate user-defined
+** event types.
+**
+** Main author: Zoltan Somogyi.
+*/
+
+#include "mercury_imp.h"
+#include "mercury_array_macros.h"
+#include "mercury_layout_util.h"
+#include "mercury_runtime_util.h"
+#include "mercury_trace_base.h"
+
+#include "mercury_event_spec.h"
+#include "mercury_event_spec_missing.h"
+#include "mercury_event_scanner.h"
+#include "mercury_event_parser.h"
+
+#include <stdlib.h>
+
+/**************************************************************************/
+
+/*
+** The table of event specifications, with counters saying which is the next
+** free slot and how many slots are allocated.
+*/
+
+MR_EventSpec *MR_event_specs = NULL;
+int MR_event_spec_next = 0;
+int MR_event_spec_max = 0;
+
+static const char *MR_event_spec_chars;
+static unsigned MR_event_spec_char_next;
+static unsigned MR_event_spec_char_max;
+
+static int MR_compare_event_specs(const void *, const void *);
+
+static void MR_print_attr_type_term(FILE *fp, MR_CTerm term);
+static void MR_print_attr_synth_call(FILE *fp, MR_FlatTerm call);
+
+/**************************************************************************/
+
+int
+MR_event_get_input(char *buf, int buf_size)
+{
+ unsigned num_copied;
+
+ if (MR_event_spec_char_next + buf_size < MR_event_spec_char_max) {
+ num_copied = buf_size;
+ } else {
+ num_copied = MR_event_spec_char_max - MR_event_spec_char_next;
+ }
+
+ memcpy(buf, MR_event_spec_chars + MR_event_spec_char_next, num_copied);
+ MR_event_spec_char_next += num_copied;
+
+#if 0
+ {
+ int i;
+
+ fprintf(stderr, "<<<");
+ for (i = 0; i < num_copied; i++) {
+ fprintf(stderr, "%c", buf[i]);
+ }
+ fprintf(stderr, ">>>");
+ }
+#endif
+
+ return num_copied;
+}
+
+MR_bool
+MR_read_event_specs(const char *input_data)
+{
+ MR_EventSpecs cur;
+
+ /*
+ ** Set these globals up for calls to MR_event_get_input by the scanner.
+ ** The -1 is because MR_event_spec_char_max should contain the index
+ ** of the last byte in the string, not the index of the NULL byte.
+ */
+ MR_event_spec_chars = input_data;
+ MR_event_spec_char_max = strlen(input_data) - 1;
+ MR_event_spec_char_next = 0;
+
+ if (mercury_event_parse() != 0) {
+ return MR_FALSE;
+ }
+
+ MR_event_spec_max = 0;
+ for (cur = mercury_event_parsetree; cur != NULL; cur = cur->MR_events_tail)
+ {
+ MR_event_spec_max++;
+ }
+
+ MR_event_specs = MR_NEW_ARRAY(MR_EventSpec, MR_event_spec_max);
+
+ MR_event_spec_next = 0;
+ for (cur = mercury_event_parsetree; cur != NULL; cur = cur->MR_events_tail)
+ {
+ MR_event_specs[MR_event_spec_next] = cur->MR_events_head;
+ MR_event_spec_next++;
+ }
+
+ /*
+ ** We keep the events in the original order, which will be the order
+ ** in which we assign them event numbers; the code here is in case
+ ** in future we want to order them by name.
+ */
+
+#if 0
+ qsort(MR_event_specs, MR_event_spec_max, sizeof(MR_EventSpec),
+ MR_compare_event_specs);
+#endif
+
+ return MR_TRUE;
+}
+
+static int
+MR_compare_event_specs(const void *a, const void *b)
+{
+ MR_EventSpec *a_event;
+ MR_EventSpec *b_event;
+
+ a_event = (MR_EventSpec *) a;
+ b_event = (MR_EventSpec *) b;
+
+ return strcmp((*a_event)->MR_event_name, (*b_event)->MR_event_name);
+}
+
+void
+MR_print_event_specs(FILE *fp)
+{
+ int event_num;
+ MR_EventSpec event;
+ MR_EventAttr attr;
+ MR_EventAttrs attrs;
+
+ fprintf(fp, "[\n");
+
+ for (event_num = 0; event_num < MR_event_spec_max; event_num++) {
+ event = MR_event_specs[event_num];
+ fprintf(fp, "event_spec_term(\"%s\", %d, %d, [\n",
+ event->MR_event_name, event->MR_event_num, event->MR_event_lineno);
+
+ for (attrs = event->MR_event_attributes; attrs != NULL;
+ attrs = attrs->MR_attrs_tail)
+ {
+ attr = attrs->MR_attrs_head;
+
+ fprintf(fp, " event_attr_term(\"%s\", ", attr->MR_attr_name);
+ switch (attr->MR_attr_type->MR_type_kind) {
+ case MR_EVENT_ATTR_ORDINARY:
+ fprintf(fp, "event_attr_type_ordinary(");
+ MR_print_attr_type_term(fp,
+ attr->MR_attr_type->MR_type_term);
+ fprintf(fp, ")");
+ break;
+
+ case MR_EVENT_ATTR_FUNCTION:
+ fprintf(fp, "event_attr_type_function");
+ break;
+
+ case MR_EVENT_ATTR_SYNTHESIZED:
+ fprintf(fp, "event_attr_type_synthesized(");
+ MR_print_attr_type_term(fp,
+ attr->MR_attr_type->MR_type_term);
+ fprintf(fp, ",\n ");
+ MR_print_attr_synth_call(fp,
+ attr->MR_attr_type->MR_type_synth_call);
+ fprintf(fp, ")");
+ break;
+ }
+
+ if (attrs->MR_attrs_tail == NULL) {
+ fprintf(fp, ")\n");
+ } else {
+ fprintf(fp, "),\n");
+ }
+ }
+
+ if (event_num == MR_event_spec_max - 1) {
+ fprintf(fp, "])\n");
+ } else {
+ fprintf(fp, "]),\n");
+ }
+ }
+
+ fprintf(fp, "].\n");
+}
+
+static void
+MR_print_attr_type_term(FILE *fp, MR_CTerm term)
+{
+ MR_CArgs args;
+
+ fprintf(fp, "event_attr_type_term(\"%s\", [", term->MR_term_functor);
+
+ for (args = term->MR_term_args; args != NULL; args = args->MR_args_tail) {
+ MR_print_attr_type_term(fp, args->MR_args_head);
+ if (args->MR_args_tail != NULL) {
+ fprintf(fp, ",");
+ }
+ }
+
+ fprintf(fp, "])");
+}
+
+static void
+MR_print_attr_synth_call(FILE *fp, MR_FlatTerm call)
+{
+ MR_FlatArgs args;
+
+ fprintf(fp, "attr_synth_call(\"%s\", [", call->MR_flat_term_functor);
+
+ for (args = call->MR_flat_term_args; args != NULL;
+ args = args->MR_flat_args_tail)
+ {
+ if (args->MR_flat_args_tail == NULL) {
+ fprintf(fp, "\"%s\"", args->MR_flat_args_head);
+ } else {
+ fprintf(fp, "\"%s\",", args->MR_flat_args_head);
+ }
+ }
+
+ fprintf(fp, "])");
+}
Index: trace/mercury_event_spec.h
===================================================================
RCS file: trace/mercury_event_spec.h
diff -N trace/mercury_event_spec.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ trace/mercury_event_spec.h 19 Nov 2006 22:37:48 -0000
@@ -0,0 +1,97 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This file contains the declarations of the types and functions that
+** we use to represent and manipulate user-defined event types.
+**
+** Main author: Zoltan Somogyi.
+*/
+
+#ifndef MERCURY_TRACE_EVENT_H
+#define MERCURY_TRACE_EVENT_H
+
+#include "mercury_std.h" /* for MR_bool */
+#include "mercury_trace_term.h" /* for MR_CTerm and MR_FlatTerm */
+
+typedef struct MR_EventSpecs_Struct *MR_EventSpecs;
+typedef struct MR_EventSpec_Struct *MR_EventSpec;
+typedef struct MR_EventAttrs_Struct *MR_EventAttrs;
+typedef struct MR_EventAttr_Struct *MR_EventAttr;
+typedef struct MR_EventAttrType_Struct *MR_EventAttrType;
+
+struct MR_EventSpecs_Struct {
+ MR_EventSpec MR_events_head;
+ MR_EventSpecs MR_events_tail;
+};
+
+struct MR_EventAttrs_Struct {
+ MR_EventAttr MR_attrs_head;
+ MR_EventAttrs MR_attrs_tail;
+};
+
+struct MR_EventSpec_Struct {
+ unsigned MR_event_num;
+ int MR_event_lineno;
+ const char *MR_event_name;
+ MR_EventAttrs MR_event_attributes;
+};
+
+struct MR_EventAttr_Struct {
+ const char *MR_attr_name;
+ MR_EventAttrType MR_attr_type;
+};
+
+typedef enum {
+ MR_EVENT_ATTR_ORDINARY,
+ MR_EVENT_ATTR_FUNCTION,
+ MR_EVENT_ATTR_SYNTHESIZED
+} MR_EventAttrKind;
+
+struct MR_EventAttrType_Struct {
+ MR_EventAttrKind MR_type_kind;
+ MR_CTerm MR_type_term; /* if ORDINARY or SYNTHESIZED */
+ MR_FlatTerm MR_type_synth_call; /* if SYNTHESIZED */
+};
+
+/*
+** Read the specification of a set of event types from the given string, which
+** should be the contents of the event set specification file. Record the
+** result in the module's private data structures. Return true if the operation
+** succeeded; otherwise, return false.
+*/
+
+extern MR_bool MR_read_event_specs(const char *event_spec);
+
+/*
+** The flex-generated scanner uses this function to read its input directly
+** from the consensus event set specification. It reads up to buf_size bytes
+** into buf, and returns the number of bytes read.
+*/
+
+extern int MR_event_get_input(char *buf, int buf_size);
+
+/*
+** Print out the set of event specifications recorded in the module's private
+** data structures to the given stream as a single Mercury term.
+*/
+
+extern void MR_print_event_specs(FILE *fp);
+
+
+/*
+** The table of event specifications, with counters saying which is the next
+** free slot and how many slots are allocated.
+*/
+
+extern MR_EventSpec *MR_event_specs;
+extern int MR_event_spec_next;
+extern int MR_event_spec_max;
+
+#endif /* not MERCURY_TRACE_EVENT_H */
Index: trace/mercury_event_spec_missing.h
===================================================================
RCS file: trace/mercury_event_spec_missing.h
diff -N trace/mercury_event_spec_missing.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ trace/mercury_event_spec_missing.h 12 Nov 2006 09:21:41 -0000
@@ -0,0 +1,30 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This file contains the declarations that flex and bison should put,
+** or let us programmers put, into the header files they create, but don't.
+**
+** Main author: Zoltan Somogyi.
+*/
+
+#ifndef MERCURY_TRACE_EVENT_MISSING_H
+#define MERCURY_TRACE_EVENT_MISSING_H
+
+#include <stdio.h>
+#include "mercury_event_spec.h"
+
+extern char *mercury_event_text;
+extern const char *mercury_event_filename;
+extern int mercury_event_linenum;
+
+extern MR_EventSpecs mercury_event_parsetree;
+extern int mercury_event_parse(void);
+
+#endif /* not MERCURY_TRACE_EVENT_MISSING_H */
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.98
diff -u -b -r1.98 mercury_trace.c
--- trace/mercury_trace.c 13 Nov 2006 07:37:45 -0000 1.98
+++ trace/mercury_trace.c 18 Nov 2006 16:37:24 -0000
@@ -305,6 +305,15 @@
goto check_stop_print;
}
+ case MR_CMD_USER:
+ port = (MR_Trace_Port) layout->MR_sll_port;
+ if (port == MR_PORT_USER) {
+ return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
+ seqno, depth);
+ } else {
+ goto check_stop_print;
+ }
+
case MR_CMD_MIN_DEPTH:
if (MR_trace_ctrl.MR_trace_stop_depth <= depth) {
port = (MR_Trace_Port) layout->MR_sll_port;
Index: trace/mercury_trace.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace.h,v
retrieving revision 1.33
diff -u -b -r1.33 mercury_trace.h
--- trace/mercury_trace.h 10 Nov 2006 03:24:16 -0000 1.33
+++ trace/mercury_trace.h 18 Nov 2006 16:34:43 -0000
@@ -175,6 +175,9 @@
** If MR_trace_cmd == MR_CMD_RETURN, the event handler will stop at
** the next event of any call whose port is *not* EXIT.
**
+** If MR_trace_cmd == MR_CMD_USER, the event handler will stop at the
+** next user-defined event.
+**
** If MR_trace_cmd == MR_CMD_MIN_DEPTH, the event handler will stop at
** the next event of any call whose depth is at least MR_trace_stop_depth.
**
@@ -197,6 +200,7 @@
MR_CMD_RESUME_FORWARD,
MR_CMD_EXCP,
MR_CMD_RETURN,
+ MR_CMD_USER,
MR_CMD_MIN_DEPTH,
MR_CMD_MAX_DEPTH,
MR_CMD_TO_END
Index: trace/mercury_trace_cmd_browsing.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_browsing.c,v
retrieving revision 1.2
diff -u -b -r1.2 mercury_trace_cmd_browsing.c
--- trace/mercury_trace_cmd_browsing.c 5 Apr 2006 04:03:28 -0000 1.2
+++ trace/mercury_trace_cmd_browsing.c 17 Nov 2006 03:59:22 -0000
@@ -196,8 +196,7 @@
const char *problem;
problem = MR_trace_browse_one_goal(MR_mdb_out,
- MR_trace_browse_goal_internal,
- MR_BROWSE_CALLER_PRINT, format);
+ MR_trace_browse_goal_internal, MR_BROWSE_CALLER_PRINT, format);
if (problem != NULL) {
fflush(MR_mdb_out);
Index: trace/mercury_trace_cmd_forward.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_forward.c,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_trace_cmd_forward.c
--- trace/mercury_trace_cmd_forward.c 4 Apr 2006 07:37:28 -0000 1.1
+++ trace/mercury_trace_cmd_forward.c 18 Nov 2006 16:45:55 -0000
@@ -259,6 +259,25 @@
}
MR_Next
+MR_trace_cmd_user(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
+ MR_Event_Info *event_info, MR_Code **jumpaddr)
+{
+ cmd->MR_trace_strict = MR_TRUE;
+ cmd->MR_trace_print_level = MR_default_print_level;
+ MR_init_trace_check_integrity(cmd);
+ if (! MR_trace_options_movement_cmd(cmd, &words, &word_count)) {
+ ; /* the usage message has already been printed */
+ } else if (word_count == 1) {
+ cmd->MR_trace_cmd = MR_CMD_USER;
+ return STOP_INTERACTING;
+ } else {
+ MR_trace_usage_cur_cmd();
+ }
+
+ return KEEP_INTERACTING;
+}
+
+MR_Next
MR_trace_cmd_forward(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
MR_Event_Info *event_info, MR_Code **jumpaddr)
{
Index: trace/mercury_trace_cmd_forward.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_forward.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_trace_cmd_forward.h
--- trace/mercury_trace_cmd_forward.h 4 Apr 2006 07:37:29 -0000 1.1
+++ trace/mercury_trace_cmd_forward.h 18 Nov 2006 16:45:56 -0000
@@ -18,6 +18,7 @@
extern MR_TraceCmdFunc MR_trace_cmd_fail;
extern MR_TraceCmdFunc MR_trace_cmd_exception;
extern MR_TraceCmdFunc MR_trace_cmd_return;
+extern MR_TraceCmdFunc MR_trace_cmd_user;
extern MR_TraceCmdFunc MR_trace_cmd_forward;
extern MR_TraceCmdFunc MR_trace_cmd_mindepth;
extern MR_TraceCmdFunc MR_trace_cmd_maxdepth;
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.104
diff -u -b -r1.104 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 9 Oct 2006 06:40:28 -0000 1.104
+++ trace/mercury_trace_declarative.c 13 Nov 2006 12:48:04 -0000
@@ -744,7 +744,7 @@
trace = MR_trace_decl_excp(event_info, trace);
break;
- case MR_PORT_SOLVER:
+ case MR_PORT_USER:
/* do nothing */
break;
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.226
diff -u -b -r1.226 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 13 Nov 2006 07:37:45 -0000 1.226
+++ trace/mercury_trace_internal.c 19 Nov 2006 14:13:35 -0000
@@ -23,6 +23,8 @@
#include "mercury_builtin_types.h"
#include "mercury_deep_profiling.h"
+#include "mercury_event_spec.h"
+
#include "mercury_trace.h"
#include "mercury_trace_internal.h"
#include "mercury_trace_cmds.h"
@@ -355,6 +357,18 @@
MR_io_tabling_start = MR_IO_ACTION_MAX;
MR_io_tabling_end = MR_IO_ACTION_MAX;
+ if (MR_event_specs_have_conflict) {
+ fprintf(MR_mdb_out,
+ "The executable's modules were compiled with "
+ "an inconsistent set of user event specifications.\n");
+ } else if (MR_consensus_event_specs != NULL) {
+ if (! MR_read_event_specs(MR_consensus_event_specs)) {
+ fprintf(MR_mdb_out,
+ "Internal error: "
+ "could not parse the event set specification.\n");
+ }
+ }
+
MR_trace_internal_initialized = MR_TRUE;
}
}
@@ -1504,6 +1518,8 @@
MR_trace_movement_cmd_args, MR_trace_null_completer },
{ "forward", "return", MR_trace_cmd_return,
MR_trace_movement_cmd_args, MR_trace_null_completer },
+ { "forward", "user", MR_trace_cmd_user,
+ MR_trace_movement_cmd_args, MR_trace_null_completer },
{ "forward", "forward", MR_trace_cmd_forward,
MR_trace_movement_cmd_args, MR_trace_null_completer },
{ "forward", "mindepth", MR_trace_cmd_mindepth,
Index: trace/mercury_trace_spy.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_spy.c,v
retrieving revision 1.27
diff -u -b -r1.27 mercury_trace_spy.c
Index: trace/mercury_trace_tables.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_tables.c,v
retrieving revision 1.43
diff -u -b -r1.43 mercury_trace_tables.c
--- trace/mercury_trace_tables.c 20 Aug 2006 05:41:45 -0000 1.43
+++ trace/mercury_trace_tables.c 18 Nov 2006 14:45:11 -0000
@@ -17,6 +17,7 @@
#include "mercury_imp.h"
#include "mercury_label.h"
#include "mercury_array_macros.h"
+#include "mercury_stack_layout.h"
#include "mercury_stack_trace.h"
#include "mercury_dlist.h"
@@ -29,6 +30,10 @@
#include <string.h>
#include <ctype.h>
+const char *MR_consensus_event_specs = NULL;
+MR_bool MR_event_specs_have_conflict = MR_FALSE;
+
+
/*
** We record module layout structures in two tables. The MR_module_infos
** array contains one pointer to every module layout structure, and is ordered
@@ -165,6 +170,20 @@
if (MR_search_module_info_by_name(module->MR_ml_name) == NULL) {
MR_insert_module_info(module);
+
+ if (module->MR_ml_version_number >= MR_LAYOUT_VERSION__USER_DEFINED) {
+ if (module->MR_ml_event_specs != NULL) {
+ if (MR_consensus_event_specs == NULL) {
+ MR_consensus_event_specs = module->MR_ml_event_specs;
+ } else {
+ if (MR_strdiff(MR_consensus_event_specs,
+ module->MR_ml_event_specs))
+ {
+ MR_event_specs_have_conflict = MR_TRUE;
+ } /* else this module has the same specs as the consensus */
+ }
+ }
+ }
}
}
Index: trace/mercury_trace_tables.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_tables.h,v
retrieving revision 1.24
diff -u -b -r1.24 mercury_trace_tables.h
--- trace/mercury_trace_tables.h 10 Nov 2006 03:24:18 -0000 1.24
+++ trace/mercury_trace_tables.h 18 Nov 2006 14:45:12 -0000
@@ -41,6 +41,25 @@
const MR_Module_Layout *module);
/*
+** Every module that generates user defined events has a specification of the
+** set of user events it was compiled with in its module layout structure.
+** The debugger needs to know what these specifications are, and if they
+** are consistent (which in this case means identical).
+**
+** If no modules have user defined events, MR_event_specs_have_conflict will
+** be false and MR_consensus_event_specs will be NULL. If there are some user
+** defined events in some modules and the modules are consistent, then
+** MR_event_specs_have_conflict will still be false and the string will contain
+** a copy of the original specification file in a canonical form (standard
+** indentation, comments stripped). If there is an inconsistency, then
+** MR_event_specs_have_conflict will be TRUE, and MR_consensus_event_specs
+** will not be meaningful.
+*/
+
+extern const char *MR_consensus_event_specs;
+extern MR_bool MR_event_specs_have_conflict;
+
+/*
** MR_process_file_line_layouts searches all the module layout structures
** of the program for label layout structures corresponding to the given
** filename/linenumber combination. For all such labels, it calls the supplied
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.69
diff -u -b -r1.69 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 28 Mar 2006 08:07:29 -0000 1.69
+++ trace/mercury_trace_vars.c 18 Nov 2006 16:29:31 -0000
@@ -73,9 +73,33 @@
MR_bool MR_var_is_ambiguous;
int MR_var_hlds_number;
int MR_var_seq_num_in_label;
- MR_TypeInfo MR_var_type;
- MR_Word MR_var_value;
-} MR_Var_Details;
+} MR_ProgVarDetails;
+
+typedef struct {
+ unsigned MR_attr_num;
+ char *MR_attr_name;
+} MR_AttributeDetails;
+
+typedef union {
+ MR_ProgVarDetails MR_details_var;
+ MR_AttributeDetails MR_details_attr;
+} MR_KindDetails;
+
+typedef enum {
+ /* Some of the code below depends on attributes coming before variables. */
+ MR_VALUE_ATTRIBUTE,
+ MR_VALUE_PROG_VAR
+} MR_ValueKind;
+
+typedef struct {
+ MR_ValueKind MR_value_kind;
+ MR_KindDetails MR_value_details;
+ MR_TypeInfo MR_value_type;
+ MR_Word MR_value_value;
+} MR_ValueDetails;
+
+#define MR_value_var MR_value_details.MR_details_var
+#define MR_value_attr MR_value_details.MR_details_attr
/*
** This structure contains all of the debugger's information about
@@ -120,14 +144,20 @@
MR_Word *MR_point_level_base_curfr;
int MR_point_var_count;
int MR_point_var_max;
- MR_Var_Details *MR_point_vars;
+ MR_ValueDetails *MR_point_vars;
} MR_Point;
static MR_bool MR_trace_type_is_ignored(
MR_PseudoTypeInfo pseudo_type_info,
MR_bool print_optionals);
-static int MR_trace_compare_var_details(const void *arg1,
- const void *arg2);
+static int MR_trace_compare_value_details(
+ const void *arg1, const void *arg2);
+static int MR_trace_compare_attr_details(
+ const MR_AttributeDetails *attr1,
+ const MR_AttributeDetails *attr2);
+static int MR_trace_compare_var_details(
+ const MR_ProgVarDetails *var1,
+ const MR_ProgVarDetails *var2);
static int MR_compare_slots_on_headvar_num(const void *p1,
const void *p2);
static const char *MR_trace_browse_one_path(FILE *out,
@@ -147,8 +177,8 @@
static char *MR_trace_var_completer_next(const char *word,
size_t word_len, MR_Completer_Data *data);
static int MR_trace_print_var_name(FILE *out,
- MR_Var_Details *var);
-static const char *MR_trace_printed_var_name(MR_Var_Details *var);
+ MR_ValueDetails *var);
+static const char *MR_trace_printed_var_name(MR_ValueDetails *var);
static const char *MR_trace_valid_var_number(int var_number);
#define MR_INIT_VAR_DETAIL_COUNT 20
@@ -319,8 +349,11 @@
MR_bool print_optionals)
{
const MR_Proc_Layout *entry;
+ const MR_UserEvent *user;
MR_Word *valid_saved_regs;
int var_count;
+ int attr_count;
+ int total_count;
int num_added_args;
int arity;
MR_PredFunc pred_or_func;
@@ -335,6 +368,8 @@
const char *name;
const char *filename;
int linenumber;
+ char *attr_name;
+ MR_bool succeeded;
entry = level_layout->MR_sll_entry;
if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
@@ -345,16 +380,19 @@
return "there is no information about live variables";
}
+ if (level_layout->MR_sll_var_nums == NULL) {
+ return "there are no names for the live variables";
+ }
+
if (! MR_find_context(level_layout, &filename, &linenumber)) {
filename = "";
linenumber = 0;
}
/*
- ** After this point, we cannot find any more problems
- ** that would prevent us from assembling an accurate picture
- ** of the set of live variables at the given level,
- ** so we are free to modify the MR_point structure.
+ ** After this point, we cannot find any more problems that would prevent us
+ ** from assembling an accurate picture of the set of live variables
+ ** at the given level, so we are free to modify the MR_point structure.
*/
MR_point.MR_point_problem = NULL;
@@ -369,23 +407,27 @@
var_count = MR_all_desc_var_count(level_layout);
} else {
/*
- ** If the count of variables is zero, then the rest of the
- ** information about the set of live variables (e.g. the
- ** type parameter array pointer) is not present. Continuing
- ** would therefore lead to a core dump.
+ ** If the count of variables is zero, then the rest of the information
+ ** about the set of live variables (e.g. the type parameter array
+ ** pointer) is not present. Continuing would therefore lead to a
+ ** core dump.
**
- ** Instead, we set up the remaining meaningful fields
- ** of MR_point.
+ ** Instead, we set up the remaining meaningful fields of MR_point.
*/
MR_point.MR_point_var_count = 0;
return NULL;
}
- if (level_layout->MR_sll_var_nums == NULL) {
- return "there are no names for the live variables";
+ user = level_layout->MR_sll_user_event;
+ if (user != NULL) {
+ attr_count = user->MR_ue_num_attrs;
+ } else {
+ attr_count = 0;
}
+ total_count = var_count + attr_count;
+
if (MR_saved_curfr(MR_point.MR_point_top_saved_regs) == base_curfr
&& MR_saved_sp(MR_point.MR_point_top_saved_regs) == base_sp
&& MR_point.MR_point_top_port != MR_PORT_EXCEPTION)
@@ -398,19 +440,55 @@
type_params = MR_materialize_type_params_base(level_layout,
valid_saved_regs, base_sp, base_curfr);
- MR_ensure_big_enough(var_count, MR_point.MR_point_var,
- MR_Var_Details, MR_INIT_VAR_DETAIL_COUNT);
+ MR_ensure_big_enough(total_count, MR_point.MR_point_var,
+ MR_ValueDetails, MR_INIT_VAR_DETAIL_COUNT);
for (slot = 0; slot < MR_point.MR_point_var_count; slot++) {
- /* free the memory allocated by previous MR_copy_string */
- MR_free(MR_point.MR_point_vars[slot].MR_var_fullname);
- MR_free(MR_point.MR_point_vars[slot].MR_var_basename);
+ switch (MR_point.MR_point_vars[slot].MR_value_kind) {
+ /*
+ ** Free the memory allocated by invocations of MR_copy_string
+ ** in the previous call to this function.
+ */
+
+ case MR_VALUE_PROG_VAR:
+ MR_free(MR_point.MR_point_vars[slot].MR_value_var.
+ MR_var_fullname);
+ MR_free(MR_point.MR_point_vars[slot].MR_value_var.
+ MR_var_basename);
+ break;
+
+ case MR_VALUE_ATTRIBUTE:
+ MR_free(MR_point.MR_point_vars[slot].MR_value_attr.
+ MR_attr_name);
+ break;
+ }
}
MR_proc_id_arity_addedargs_predfunc(entry, &arity, &num_added_args,
&pred_or_func);
slot = 0;
+ for (i = 0; i < attr_count; i++) {
+ succeeded = MR_FALSE;
+
+ value = MR_lookup_long_lval_base(user->MR_ue_attr_locns[i],
+ valid_saved_regs, base_sp, base_curfr, &succeeded);
+
+ if (! succeeded) {
+ MR_fatal_error("cannot look up value of attribute");
+ }
+
+ type_info = user->MR_ue_attr_types[i];
+ attr_name = MR_copy_string(user->MR_ue_attr_names[i]);
+
+ MR_point.MR_point_vars[slot].MR_value_kind = MR_VALUE_ATTRIBUTE;
+ MR_point.MR_point_vars[slot].MR_value_type = type_info;
+ MR_point.MR_point_vars[slot].MR_value_value = value;
+ MR_point.MR_point_vars[slot].MR_value_attr.MR_attr_num = i;
+ MR_point.MR_point_vars[slot].MR_value_attr.MR_attr_name = attr_name;
+ slot++;
+ }
+
for (i = 0; i < var_count; i++) {
int hlds_var_num;
int head_var_num;
@@ -420,7 +498,7 @@
hlds_var_num = level_layout->MR_sll_var_nums[i];
name = MR_hlds_var_name(entry, hlds_var_num);
if (name == NULL || MR_streq(name, "")) {
- /* this value is not a variable or is not named by the user */
+ /* This value is not a variable or is not named by the user. */
continue;
}
@@ -432,52 +510,59 @@
if (! MR_get_type_and_value_base(level_layout, i, valid_saved_regs,
base_sp, base_curfr, type_params, &type_info, &value))
{
- /* this value is not a variable */
+ /* This value is not a variable. */
continue;
}
- MR_point.MR_point_vars[slot].MR_var_hlds_number = hlds_var_num;
- MR_point.MR_point_vars[slot].MR_var_seq_num_in_label = i;
+ MR_point.MR_point_vars[slot].MR_value_kind = MR_VALUE_PROG_VAR;
+ MR_point.MR_point_vars[slot].MR_value_type = type_info;
+ MR_point.MR_point_vars[slot].MR_value_value = value;
+
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_hlds_number =
+ hlds_var_num;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_seq_num_in_label = i;
copy = MR_copy_string(name);
- MR_point.MR_point_vars[slot].MR_var_fullname = copy;
- MR_point.MR_point_vars[slot].MR_var_type = type_info;
- MR_point.MR_point_vars[slot].MR_var_value = value;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_fullname = copy;
- /* we need another copy we can cut apart */
+ /* We need another copy we can cut apart. */
copy = MR_copy_string(name);
start_of_num = MR_find_start_of_num_suffix(copy);
if (start_of_num < 0) {
- MR_point.MR_point_vars[slot].MR_var_has_suffix = MR_FALSE;
- /* num_suffix should not be used */
- MR_point.MR_point_vars[slot].MR_var_num_suffix = -1;
- MR_point.MR_point_vars[slot].MR_var_basename = copy;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_has_suffix =
+ MR_FALSE;
+ /* Num_suffix should not be used. */
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_num_suffix = -1;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_basename = copy;
} else {
if (start_of_num == 0) {
MR_fatal_error("variable name starts with digit");
}
num_addr = copy + start_of_num;
- MR_point.MR_point_vars[slot].MR_var_has_suffix = MR_TRUE;
- MR_point.MR_point_vars[slot].MR_var_num_suffix = atoi(num_addr);
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_has_suffix =
+ MR_TRUE;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_num_suffix =
+ atoi(num_addr);
*num_addr = '\0';
- MR_point.MR_point_vars[slot].MR_var_basename = copy;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_basename = copy;
}
- MR_point.MR_point_vars[slot].MR_var_is_headvar = 0;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_is_headvar = 0;
for (head_var_num = num_added_args;
head_var_num < entry->MR_sle_num_head_vars;
head_var_num++)
{
if (entry->MR_sle_head_var_nums[head_var_num] == hlds_var_num) {
- MR_point.MR_point_vars[slot].MR_var_is_headvar =
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_is_headvar =
head_var_num - num_added_args + 1;
break;
}
}
- MR_point.MR_point_vars[slot].MR_var_is_ambiguous = MR_FALSE;
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_is_ambiguous =
+ MR_FALSE;
slot++;
}
@@ -485,27 +570,29 @@
MR_free(type_params);
if (slot_max > 0) {
- qsort(MR_point.MR_point_vars, slot_max, sizeof(MR_Var_Details),
- MR_trace_compare_var_details);
+ qsort(MR_point.MR_point_vars, slot_max, sizeof(MR_ValueDetails),
+ MR_trace_compare_value_details);
- slot = 1;
- for (i = 1; i < slot_max; i++) {
- if (MR_point.MR_point_vars[i].MR_var_hlds_number ==
- MR_point.MR_point_vars[i-1].MR_var_hlds_number)
+ /* This depends on attributes coming before program variables. */
+ slot = attr_count + 1;
+ for (i = attr_count + 1; i < slot_max; i++) {
+ if (MR_point.MR_point_vars[i].MR_value_var.MR_var_hlds_number ==
+ MR_point.MR_point_vars[i - 1].MR_value_var.MR_var_hlds_number)
{
continue;
}
MR_memcpy(&MR_point.MR_point_vars[slot],
- &MR_point.MR_point_vars[i],
- sizeof(MR_Var_Details));
+ &MR_point.MR_point_vars[i], sizeof(MR_ValueDetails));
if (MR_streq(
- MR_point.MR_point_vars[slot].MR_var_fullname,
- MR_point.MR_point_vars[slot-1].MR_var_fullname))
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_fullname,
+ MR_point.MR_point_vars[slot - 1].MR_value_var.MR_var_fullname))
{
- MR_point.MR_point_vars[slot - 1].MR_var_is_ambiguous = MR_TRUE;
- MR_point.MR_point_vars[slot].MR_var_is_ambiguous = MR_TRUE;
+ MR_point.MR_point_vars[slot - 1].MR_value_var.
+ MR_var_is_ambiguous = MR_TRUE;
+ MR_point.MR_point_vars[slot].MR_value_var.
+ MR_var_is_ambiguous = MR_TRUE;
}
slot++;
@@ -519,13 +606,17 @@
}
/*
-** This comparison function is used to sort variables
+** This comparison function is used to sort values
**
-** - first on basename,
+** - first on attribute vs variable
+** - then,
+** - for attributes, on attribute number
+** - for variables, on
+** - on basename,
** - then on suffix,
** - and then, if necessary, on HLDS number.
**
-** The sorting on basenames is alphabetical except for head variables,
+** The sorting on variable basenames is alphabetical except for head variables,
** which always come out first.
**
** The sorting on suffixes orders variables with the same basename
@@ -535,17 +626,51 @@
*/
static int
-MR_trace_compare_var_details(const void *arg1, const void *arg2)
+MR_trace_compare_value_details(const void *arg1, const void *arg2)
+{
+ MR_ValueDetails *value1;
+ MR_ValueDetails *value2;
+ int diff;
+
+ value1 = (MR_ValueDetails *) arg1;
+ value2 = (MR_ValueDetails *) arg2;
+
+ if (value1->MR_value_kind != value2->MR_value_kind) {
+ return (int) value1->MR_value_kind - (int) value2->MR_value_kind;
+ }
+
+ switch (value1->MR_value_kind) {
+ case MR_VALUE_ATTRIBUTE:
+ return MR_trace_compare_attr_details(
+ &value1->MR_value_attr, &value2->MR_value_attr);
+
+ case MR_VALUE_PROG_VAR:
+ return MR_trace_compare_var_details(
+ &value1->MR_value_var, &value2->MR_value_var);
+ }
+
+ MR_fatal_error("MR_trace_compare_value_details: fall through");
+ /* NOTREACHED */
+ return 0;
+}
+
+static int
+MR_trace_compare_attr_details(
+ const MR_AttributeDetails *attr1,
+ const MR_AttributeDetails *attr2)
+{
+ return attr1->MR_attr_num - attr2->MR_attr_num;
+}
+
+static int
+MR_trace_compare_var_details(
+ const MR_ProgVarDetails *var1,
+ const MR_ProgVarDetails *var2)
{
- MR_Var_Details *var1;
- MR_Var_Details *var2;
int var1_is_headvar;
int var2_is_headvar;
int diff;
- var1 = (MR_Var_Details *) arg1;
- var2 = (MR_Var_Details *) arg2;
-
var1_is_headvar = var1->MR_var_is_headvar;
var2_is_headvar = var2->MR_var_is_headvar;
if (var1_is_headvar && var2_is_headvar) {
@@ -642,7 +767,9 @@
const char *
MR_trace_list_var_details(FILE *out)
{
- MR_Var_Details *details;
+ MR_ValueDetails *value;
+ MR_AttributeDetails *attr;
+ MR_ProgVarDetails *var;
int i;
if (MR_point.MR_point_problem != NULL) {
@@ -650,18 +777,34 @@
}
for (i = 0; i < MR_point.MR_point_var_count; i++) {
- details = &MR_point.MR_point_vars[i];
+ value = &MR_point.MR_point_vars[i];
+ switch (MR_point.MR_point_vars[i].MR_value_kind) {
+ case MR_VALUE_ATTRIBUTE:
+ attr = &value->MR_value_attr;
fprintf(out, "\n");
- fprintf(out, "slot %d, seq %d, hlds %d: headvar: %d, ambiguous: %s\n",
- i, details->MR_var_seq_num_in_label,
- details->MR_var_hlds_number, details->MR_var_is_headvar,
- details->MR_var_is_ambiguous ? "yes" : "no");
- fprintf(out, "full <%s>, base <%s>, num_suffix %d, has_suffix %s\n",
- details->MR_var_fullname, details->MR_var_basename,
- details->MR_var_num_suffix,
- details->MR_var_has_suffix ? "yes" : "no");
+ fprintf(out,
+ "slot %d, attr number %d, attribute name %s\n",
+ i, attr->MR_attr_num, attr->MR_attr_name);
+ break;
+
+ case MR_VALUE_PROG_VAR:
+ var = &value->MR_value_var;
+ fprintf(out, "\n");
+ fprintf(out,
+ "slot %d, seq %d, hlds %d: headvar: %d, ambiguous: %s\n",
+ i, var->MR_var_seq_num_in_label,
+ var->MR_var_hlds_number, var->MR_var_is_headvar,
+ var->MR_var_is_ambiguous ? "yes" : "no");
+ fprintf(out,
+ "full <%s>, base <%s>, num_suffix %d, has_suffix %s\n",
+ var->MR_var_fullname, var->MR_var_basename,
+ var->MR_var_num_suffix,
+ var->MR_var_has_suffix ? "yes" : "no");
+ break;
+ }
+
fprintf(out, "typeinfo %p, value %" MR_INTEGER_LENGTH_MODIFIER "x\n",
- details->MR_var_type, details->MR_var_value);
+ value->MR_value_type, value->MR_value_value);
}
return NULL;
@@ -671,6 +814,7 @@
MR_trace_return_hlds_var_info(int hlds_num, MR_TypeInfo *type_info_ptr,
MR_Word *value_ptr)
{
+ MR_ValueDetails *value;
int i;
if (MR_point.MR_point_problem != NULL) {
@@ -678,9 +822,13 @@
}
for (i = 0; i < MR_point.MR_point_var_count; i++) {
- if (MR_point.MR_point_vars[i].MR_var_hlds_number == hlds_num) {
- *type_info_ptr = MR_point.MR_point_vars[i].MR_var_type;
- *value_ptr = MR_point.MR_point_vars[i].MR_var_value;
+ value = &MR_point.MR_point_vars[i];
+
+ if (value->MR_value_kind == MR_VALUE_PROG_VAR &&
+ value->MR_value_var.MR_var_hlds_number == hlds_num)
+ {
+ *type_info_ptr = value->MR_value_type;
+ *value_ptr = value->MR_value_value;
return NULL;
}
}
@@ -692,7 +840,7 @@
MR_trace_return_var_info(int var_number, const char **name_ptr,
MR_TypeInfo *type_info_ptr, MR_Word *value_ptr)
{
- const MR_Var_Details *details;
+ const MR_ValueDetails *details;
const char *problem;
if (MR_point.MR_point_problem != NULL) {
@@ -707,13 +855,23 @@
details = &MR_point.MR_point_vars[var_number - 1];
if (name_ptr != NULL) {
- *name_ptr = details->MR_var_fullname;
+ switch (details->MR_value_kind) {
+ case MR_VALUE_PROG_VAR:
+ *name_ptr = details->MR_value_var.MR_var_fullname;
+ break;
+
+ case MR_VALUE_ATTRIBUTE:
+ *name_ptr = details->MR_value_attr.MR_attr_name;
+ break;
}
+ }
+
if (type_info_ptr != NULL) {
- *type_info_ptr = details->MR_var_type;
+ *type_info_ptr = details->MR_value_type;
}
+
if (value_ptr != NULL) {
- *value_ptr = details->MR_var_value;
+ *value_ptr = details->MR_value_value;
}
return NULL;
@@ -722,7 +880,7 @@
const char *
MR_trace_headvar_num(int var_number, int *arg_pos)
{
- const MR_Var_Details *details;
+ const MR_ValueDetails *details;
const char *problem;
if (MR_point.MR_point_problem != NULL) {
@@ -736,11 +894,15 @@
details = &MR_point.MR_point_vars[var_number - 1];
- if (!details->MR_var_is_headvar) {
+ if (details->MR_value_kind != MR_VALUE_PROG_VAR) {
+ return "not a variable";
+ }
+
+ if (!details->MR_value_var.MR_var_is_headvar) {
return "not a head variable";
}
- *arg_pos = details->MR_var_num_suffix;
+ *arg_pos = details->MR_value_var.MR_var_num_suffix;
return NULL;
}
@@ -770,6 +932,10 @@
var_spec->MR_var_spec_kind = MR_VAR_SPEC_HELD_NAME;
var_spec->MR_var_spec_name = word_spec + 1;
var_spec->MR_var_spec_number = -1; /* unused */
+ } else if (word_spec[0] == '!') {
+ var_spec->MR_var_spec_kind = MR_VAR_SPEC_ATTRIBUTE;
+ var_spec->MR_var_spec_name = word_spec + 1;
+ var_spec->MR_var_spec_number = -1; /* unused */
} else {
var_spec->MR_var_spec_kind = MR_VAR_SPEC_NAME;
var_spec->MR_var_spec_name = word_spec;
@@ -780,24 +946,38 @@
static int
MR_compare_slots_on_headvar_num(const void *p1, const void *p2)
{
- MR_Var_Details *vars;
+ MR_ValueDetails *vars;
int s1;
int s2;
+ int hv1;
+ int hv2;
vars = MR_point.MR_point_vars;
s1 = * (int *) p1;
s2 = * (int *) p2;
- if (! vars[s1].MR_var_is_headvar) {
- MR_fatal_error("MR_compare_slots_on_headvar_num: s1");
+ if (vars[s1].MR_value_kind != MR_VALUE_PROG_VAR) {
+ MR_fatal_error("MR_compare_slots_on_headvar_num: s1 is not var");
+ }
+
+ if (vars[s2].MR_value_kind != MR_VALUE_PROG_VAR) {
+ MR_fatal_error("MR_compare_slots_on_headvar_num: s2 is not var");
}
- if (! vars[s2].MR_var_is_headvar) {
- MR_fatal_error("MR_compare_slots_on_headvar_num: s2");
+
+ if (! vars[s1].MR_value_var.MR_var_is_headvar) {
+ MR_fatal_error("MR_compare_slots_on_headvar_num: s1 is not headvar");
+ }
+
+ if (! vars[s2].MR_value_var.MR_var_is_headvar) {
+ MR_fatal_error("MR_compare_slots_on_headvar_num: s2 is not headvar");
}
- if (vars[s1].MR_var_is_headvar < vars[s2].MR_var_is_headvar) {
+ hv1 = vars[s1].MR_value_var.MR_var_is_headvar;
+ hv2 = vars[s2].MR_value_var.MR_var_is_headvar;
+
+ if (hv1 < hv2) {
return -1;
- } else if (vars[s1].MR_var_is_headvar > vars[s2].MR_var_is_headvar) {
+ } else if (hv1 > hv2) {
return 1;
} else {
return 0;
@@ -815,7 +995,7 @@
MR_Word arg_list;
MR_Word arg;
MR_TypeInfo arg_list_typeinfo;
- MR_Var_Details *vars;
+ MR_ValueDetails *vars;
int headvar_num;
int arity;
int slot;
@@ -834,33 +1014,35 @@
next = 0;
for (slot = MR_point.MR_point_var_count - 1; slot >= 0; slot--) {
- headvar_num = vars[slot].MR_var_is_headvar;
+ if (vars[slot].MR_value_kind == MR_VALUE_PROG_VAR) {
+ headvar_num = vars[slot].MR_value_var.MR_var_is_headvar;
if (headvar_num) {
var_slot_array[next] = slot;
next++;
}
}
+ }
qsort(var_slot_array, next, sizeof(int), MR_compare_slots_on_headvar_num);
MR_TRACE_USE_HP(
/*
- ** Replace the slot numbers in the argument list
- ** with the argument values, adding entries for
- ** any unbound arguments (they will be printed
- ** as `_').
+ ** Replace the slot numbers in the argument list with the argument
+ ** values, adding entries for any unbound arguments (they will be
+ ** printed as `_').
*/
arg_list = MR_list_empty();
i = next - 1;
for (headvar_num = arity; headvar_num > 0; headvar_num--) {
if (i >= 0 &&
- vars[var_slot_array[i]].MR_var_is_headvar == headvar_num)
+ vars[var_slot_array[i]].MR_value_var.MR_var_is_headvar
+ == headvar_num)
{
slot = var_slot_array[i];
i--;
- MR_new_univ_on_hp(arg, vars[slot].MR_var_type,
- vars[slot].MR_var_value);
+ MR_new_univ_on_hp(arg, vars[slot].MR_value_type,
+ vars[slot].MR_value_value);
} else {
MR_new_univ_on_hp(arg,
(MR_TypeInfo) &MR_unbound_typeinfo_struct, MR_UNBOUND);
@@ -1091,7 +1273,8 @@
var_num++;
} while (var_num < MR_point.MR_point_var_count &&
MR_streq(var_spec.MR_var_spec_name,
- MR_point.MR_point_vars[var_num].MR_var_fullname));
+ MR_point.MR_point_vars[var_num].MR_value_var.MR_var_fullname));
+ /* Attribute names cannot be ambiguous; the compiler enforces this. */
if (success_count == 0) {
return "the selected path does not exist "
@@ -1134,8 +1317,8 @@
do {
fprintf(out, "%20s: %6u\n",
MR_point.MR_point_vars[var_num].MR_var_fullname,
- MR_term_size(MR_point.MR_point_vars[var_num].MR_var_type,
- MR_point.MR_point_vars[var_num].MR_var_value));
+ MR_term_size(MR_point.MR_point_vars[var_num].MR_value_type,
+ MR_point.MR_point_vars[var_num].MR_value_value));
var_num++;
} while (var_num < MR_point.MR_point_var_count &&
MR_streq(var_spec.MR_var_spec_name,
@@ -1165,8 +1348,8 @@
for (var_num = 0; var_num < MR_point.MR_point_var_count; var_num++) {
fprintf(out, "%-20s %6u\n",
MR_point.MR_point_vars[var_num].MR_var_fullname,
- MR_term_size(MR_point.MR_point_vars[var_num].MR_var_type,
- MR_point.MR_point_vars[var_num].MR_var_value));
+ MR_term_size(MR_point.MR_point_vars[var_num].MR_value_type,
+ MR_point.MR_point_vars[var_num].MR_value_value));
}
return NULL;
@@ -1208,8 +1391,8 @@
for (var_num = 0; var_num < MR_point.MR_point_var_count; var_num++) {
(void) MR_trace_browse_var(out, MR_TRUE,
- MR_point.MR_point_vars[var_num].MR_var_type,
- MR_point.MR_point_vars[var_num].MR_var_value,
+ MR_point.MR_point_vars[var_num].MR_value_type,
+ MR_point.MR_point_vars[var_num].MR_value_value,
MR_trace_printed_var_name(&MR_point.MR_point_vars[var_num]),
NULL, browser, MR_BROWSE_CALLER_PRINT_ALL, format);
}
@@ -1378,6 +1561,7 @@
int vn;
MR_bool found;
const char *problem;
+ MR_ValueDetails *value;
if (MR_point.MR_point_problem != NULL) {
return MR_point.MR_point_problem;
@@ -1392,8 +1576,8 @@
vn = var_spec.MR_var_spec_number - 1;
*var_index_ptr = vn;
- *type_info_ptr = MR_point.MR_point_vars[vn].MR_var_type;
- *value_ptr = MR_point.MR_point_vars[vn].MR_var_value;
+ *type_info_ptr = MR_point.MR_point_vars[vn].MR_value_type;
+ *value_ptr = MR_point.MR_point_vars[vn].MR_value_value;
*name_ptr = MR_trace_printed_var_name(&MR_point.MR_point_vars[vn]);
*is_ambiguous_ptr = MR_FALSE;
return NULL;
@@ -1401,8 +1585,10 @@
case MR_VAR_SPEC_NAME:
found = MR_FALSE;
for (vn = 0; vn < MR_point.MR_point_var_count; vn++) {
- if (MR_streq(var_spec.MR_var_spec_name,
- MR_point.MR_point_vars[vn].MR_var_fullname))
+ value = &MR_point.MR_point_vars[vn];
+ if (value->MR_value_kind == MR_VALUE_PROG_VAR &&
+ MR_streq(var_spec.MR_var_spec_name,
+ value->MR_value_var.MR_var_fullname))
{
found = MR_TRUE;
break;
@@ -1414,10 +1600,10 @@
}
*var_index_ptr = vn;
- *type_info_ptr = MR_point.MR_point_vars[vn].MR_var_type;
- *value_ptr = MR_point.MR_point_vars[vn].MR_var_value;
- *name_ptr = MR_trace_printed_var_name(&MR_point.MR_point_vars[vn]);
- if (MR_point.MR_point_vars[vn].MR_var_is_ambiguous) {
+ *type_info_ptr = MR_point.MR_point_vars[vn].MR_value_type;
+ *value_ptr = MR_point.MR_point_vars[vn].MR_value_value;
+ *name_ptr = MR_trace_printed_var_name(value);
+ if (value->MR_value_var.MR_var_is_ambiguous) {
*is_ambiguous_ptr = MR_TRUE;
} else {
*is_ambiguous_ptr = MR_FALSE;
@@ -1425,6 +1611,31 @@
return NULL;
+ case MR_VAR_SPEC_ATTRIBUTE:
+ found = MR_FALSE;
+ for (vn = 0; vn < MR_point.MR_point_var_count; vn++) {
+ value = &MR_point.MR_point_vars[vn];
+ if (value->MR_value_kind == MR_VALUE_ATTRIBUTE &&
+ MR_streq(var_spec.MR_var_spec_name,
+ value->MR_value_attr.MR_attr_name))
+ {
+ found = MR_TRUE;
+ break;
+ }
+ }
+
+ if (! found) {
+ return "there is no such variable";
+ }
+
+ *var_index_ptr = vn;
+ *type_info_ptr = MR_point.MR_point_vars[vn].MR_value_type;
+ *value_ptr = MR_point.MR_point_vars[vn].MR_value_value;
+ *name_ptr = MR_trace_printed_var_name(value);
+ *is_ambiguous_ptr = MR_FALSE;
+
+ return NULL;
+
case MR_VAR_SPEC_HELD_NAME:
*var_index_ptr = -1;
if (! MR_lookup_hold_var(var_spec.MR_var_spec_name,
@@ -1459,7 +1670,18 @@
slot = (MR_Integer) *data;
while (slot < MR_point.MR_point_var_count) {
- var_name = MR_point.MR_point_vars[slot].MR_var_fullname;
+ switch (MR_point.MR_point_vars[slot].MR_value_kind) {
+ case MR_VALUE_ATTRIBUTE:
+ var_name =
+ MR_point.MR_point_vars[slot].MR_value_attr.MR_attr_name;
+ break;
+
+ case MR_VALUE_PROG_VAR:
+ var_name =
+ MR_point.MR_point_vars[slot].MR_value_var.MR_var_fullname;
+ break;
+ }
+
slot++;
if (MR_strneq(var_name, word, word_len)) {
*data = (MR_Completer_Data) slot;
@@ -1470,34 +1692,14 @@
}
static int
-MR_trace_print_var_name(FILE *out, MR_Var_Details *var)
+MR_trace_print_var_name(FILE *out, MR_ValueDetails *value)
{
+ const char *buf;
int len;
- len = strlen(var->MR_var_fullname);
- fputs(var->MR_var_fullname, out);
- if (var->MR_var_is_ambiguous) {
- char buf[256]; /* this should be plenty big enough */
-
- sprintf(buf, "(%d)", var->MR_var_hlds_number);
- len += strlen(buf);
- fputs(buf, out);
- }
-
- /*
- ** If the variable starts with "HeadVar__" then the
- ** argument number is part of the name.
- */
- if (var->MR_var_is_headvar &&
- ! MR_streq(var->MR_var_basename, "HeadVar__"))
- {
- char buf[256]; /* this should be plenty big enough */
-
- sprintf(buf, " (arg %d)", var->MR_var_is_headvar);
- len += strlen(buf);
+ buf = MR_trace_printed_var_name(value);
+ len = strlen(buf);
fputs(buf, out);
- }
-
return len;
}
@@ -1506,12 +1708,31 @@
static char MR_var_name_buf[MR_TRACE_VAR_NAME_BUF_SIZE];
static const char *
-MR_trace_printed_var_name(MR_Var_Details *var)
+MR_trace_printed_var_name(MR_ValueDetails *value)
{
+ MR_ProgVarDetails *var;
+ MR_AttributeDetails *attr;
+
+ switch (value->MR_value_kind) {
+ case MR_VALUE_ATTRIBUTE:
+ attr = &value->MR_value_attr;
+#ifdef MR_HAVE_SNPRINTF
+ snprintf(MR_var_name_buf, MR_TRACE_VAR_NAME_BUF_SIZE,
+ "%s (attr %d)", attr->MR_attr_name, attr->MR_attr_num);
+#else
+ sprintf(MR_var_name_buf, "%s (attr %d)",
+ attr->MR_attr_name, attr->MR_attr_num);
+#endif
+ break;
+
+ case MR_VALUE_PROG_VAR:
+ var = &value->MR_value_var;
+
/*
- ** If the variable starts with "HeadVar__" then the
+ ** If the variable name starts with "HeadVar__", then the
** argument number is part of the name.
*/
+
if (var->MR_var_is_headvar &&
! MR_streq(var->MR_var_basename, "HeadVar__"))
{
@@ -1528,7 +1749,8 @@
} else {
#ifdef MR_HAVE_SNPRINTF
snprintf(MR_var_name_buf, MR_TRACE_VAR_NAME_BUF_SIZE,
- "%s (arg %d)", var->MR_var_fullname, var->MR_var_is_headvar);
+ "%s (arg %d)", var->MR_var_fullname,
+ var->MR_var_is_headvar);
#else
sprintf(MR_var_name_buf, "%s (arg %d)",
var->MR_var_fullname, var->MR_var_is_headvar);
@@ -1538,7 +1760,8 @@
if (var->MR_var_is_ambiguous) {
#ifdef MR_HAVE_SNPRINTF
snprintf(MR_var_name_buf, MR_TRACE_VAR_NAME_BUF_SIZE,
- "%s(%d)", var->MR_var_fullname, var->MR_var_hlds_number);
+ "%s(%d)", var->MR_var_fullname,
+ var->MR_var_hlds_number);
#else
sprintf(MR_var_name_buf, "%s(%d)",
var->MR_var_fullname, var->MR_var_hlds_number);
@@ -1553,6 +1776,9 @@
}
}
+ break;
+ }
+
return MR_var_name_buf;
}
@@ -1587,18 +1813,17 @@
** most misconstructed terms.
*/
(void) MR_trace_browse_var(stdout, MR_TRUE,
- MR_point.MR_point_vars[i].MR_var_type,
- MR_point.MR_point_vars[i].MR_var_value,
- MR_point.MR_point_vars[i].MR_var_fullname,
- (MR_String) (MR_Integer) "", MR_trace_print,
+ MR_point.MR_point_vars[i].MR_value_type,
+ MR_point.MR_point_vars[i].MR_value_value,
+ "IntegrityCheck", (MR_String) (MR_Integer) "", MR_trace_print,
MR_BROWSE_CALLER_PRINT, MR_BROWSE_DEFAULT_FORMAT);
/*
** Looking up the term size can lead to a crash if the term has a
** memory cell that should have but doesn't have a size slot.
*/
- (void) MR_term_size(MR_point.MR_point_vars[i].MR_var_type,
- MR_point.MR_point_vars[i].MR_var_value);
+ (void) MR_term_size(MR_point.MR_point_vars[i].MR_value_type,
+ MR_point.MR_point_vars[i].MR_value_value);
}
}
Index: trace/mercury_trace_vars.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_vars.h,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_trace_vars.h
--- trace/mercury_trace_vars.h 10 Nov 2006 03:24:18 -0000 1.30
+++ trace/mercury_trace_vars.h 17 Nov 2006 04:08:55 -0000
@@ -69,13 +69,15 @@
typedef enum {
MR_VAR_SPEC_NUMBER,
MR_VAR_SPEC_NAME,
- MR_VAR_SPEC_HELD_NAME
+ MR_VAR_SPEC_HELD_NAME,
+ MR_VAR_SPEC_ATTRIBUTE
} MR_Var_Spec_Kind;
typedef struct {
MR_Var_Spec_Kind MR_var_spec_kind;
int MR_var_spec_number; /* valid if NUMBER */
- const char *MR_var_spec_name; /* valid if NAME or HELD_NAME */
+ const char *MR_var_spec_name; /* valid if NAME, HELD_NAME */
+ /* or ATTRIBUTE */
} MR_Var_Spec;
/*
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list