mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
68cf30cb37
compiler/det_analysis.m:
Improve an error message about foreign_procs by printing it with
the context of the foreign_proc itself, not the context of the
procedure it is for. Also, make the wording more specific.
compiler/prog_event.m:
Reading event sets is currently implemented when the compiler
is compiled for the C backend (because its parser uses lex/flex
and yacc/bison). However, that is no reason for crashing the compiler if
- someone asks it to read an event set
- while the compiler is compiled to a target language other than C.
Fix this by returning an apology message instead of crashing.
tests/invalid/pragma_c_code_no_det.m:
tests/invalid/test_may_duplicate.m:
tests/invalid/test_may_export_body.m:
Add foreign procs for Java and C# as well as for C.
tests/invalid/pragma_c_code_no_det.err_exp{,2,3}:
tests/invalid/test_may_duplicate.err_exp{,2,3}:
tests/invalid/test_may_export_body.err_exp{,2,3}:
Add expected output files for Java and C#. Update the line numbers
in the expected file for C.
tests/invalid/test_type_spec.m:
Delete the parts of this test case that contain errors that we now report
when creating .int files. We now test for those errors using the new test
case tests/invalid_make_int/test_type_spec_int.
tests/invalid/test_type_spec.err_exp:
Delete the messages for the deleted errors, expect verbose errors
(see the update of Mercury.options below), and update the line numbers.
tests/invalid/try_detism.m:
Explain the reason for the need for the new .err_exp2 file.
tests/invalid/try_detism.err_exp{,2}:
Add the new .err_exp2 file for C#, which differs from the .err_exp file
only in the variable number of a compiler-generated variable.
Update the line numbers in the .err_exp file.
tests/invalid/undef_type.m:
Fix the one problem in this test case that we now report when we create
.int files. The handling of that problem is now tested in the new
tests/invalid_make_int/undef_type_int test case.
tests/invalid/undef_type.err_exp:
Don't expect a report for the fixed error.
tests/invalid/Mercury.options:
Run the test_type_spec test case with verbose errors.
tests/invalid/Mmakefile:
Don't try to execute the test cases that this diff moves to
tests/invalid_make_int.
Execute the test cases that try to read event set specifications
only when targeting C. This is not the exact condition we want,
but it is the closest to that condition that we can actually get.
tests/invalid_make_int/bad_instance.{m,int_err_exp}:
tests/invalid_make_int/type_arity.{m,int_err_exp}:
tests/invalid_make_int/undef_inst.{m,int_err_exp}:
tests/invalid_make_int/undef_mode.{m,int_err_exp}:
tests/invalid_make_int/undef_type_mod_qual.{m,int_err_exp}:
Move these tests here from tests/invalid.
tests/invalid_make_int/test_type_spec_int.{m,int_err_exp}:
tests/invalid_make_int/undef_type_int.{m,int_err_exp}:
The parts of the test_type_spec and undef_type test cases in tests/invalid
that get error messages generarated for them while making .int files.
tests/invalid_make_int/Mercury.options:
tests/invalid_make_int/Mmakefile:
Add the tests moved here, in whole or in part, from tests/invalid.
961 lines
38 KiB
Mathematica
961 lines
38 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2006-2011 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: prog_event.m.
|
|
% Author: zs.
|
|
%
|
|
% This module defines the database of information the compiler has about
|
|
% events other than the built-in set of execution tracing events.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_event.
|
|
:- interface.
|
|
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_event.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
% read_event_set(FileName, EventSetName, EventSpecMap, ErrorSpecs, !IO):
|
|
%
|
|
% Read in a set of event specifications from FileName, and return them
|
|
% in EventSetName and EventSpecMap. Set ErrorSpecs to a list of all the
|
|
% errors discovered during the process.
|
|
%
|
|
:- pred read_event_set(string::in, string::out, event_spec_map::out,
|
|
list(error_spec)::out, io::di, io::uo) is det.
|
|
|
|
% Return a description of the given event set.
|
|
%
|
|
:- func derive_event_set_data(event_set) = event_set_data.
|
|
|
|
% 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 attributes of the event.
|
|
%
|
|
:- pred event_attributes(event_spec_map::in, string::in,
|
|
list(event_attribute)::out) is semidet.
|
|
|
|
% Given an event name, returns the types of the arguments of the event.
|
|
%
|
|
:- 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(event_spec_map::in, string::in, list(mer_mode)::out)
|
|
is semidet.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.builtin_lib_types.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_type_construct.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bimap.
|
|
:- import_module digraph.
|
|
:- import_module int.
|
|
:- import_module io.file.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term_context.
|
|
|
|
read_event_set(SpecsFileName, EventSetName, 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 a 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.
|
|
|
|
make_temp_file_and_open_it(read_specs_file(SpecsFileName),
|
|
TermFileResult, !IO),
|
|
(
|
|
TermFileResult = ok({TermFileName, TermStream}),
|
|
io.read(TermStream, TermReadRes, !IO),
|
|
(
|
|
TermReadRes = ok(EventSetTerm),
|
|
EventSetTerm = event_set_spec(EventSetName,
|
|
EventSpecsTerm),
|
|
convert_list_to_spec_map(SpecsFileName, EventSpecsTerm,
|
|
map.init, EventSpecMap, [], ErrorSpecs)
|
|
;
|
|
TermReadRes = eof,
|
|
EventSetName = "",
|
|
EventSpecMap = map.init,
|
|
Pieces = [words("eof in term specification file."), nl],
|
|
ErrorSpec = simplest_no_context_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Pieces),
|
|
ErrorSpecs = [ErrorSpec]
|
|
;
|
|
TermReadRes = error(TermReadMsg, LineNumber),
|
|
EventSetName = "",
|
|
EventSpecMap = map.init,
|
|
Pieces = [words(TermReadMsg), nl],
|
|
ErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
term_context.context(TermFileName, LineNumber), Pieces),
|
|
ErrorSpecs = [ErrorSpec]
|
|
),
|
|
io.close_input(TermStream, !IO),
|
|
io.file.remove_file(TermFileName, _RemoveRes, !IO)
|
|
;
|
|
TermFileResult = error(ErrorMessage),
|
|
EventSetName = "",
|
|
EventSpecMap = map.init,
|
|
Pieces = [words(ErrorMessage), nl],
|
|
ErrorSpec = simplest_no_context_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Pieces),
|
|
ErrorSpecs = [ErrorSpec]
|
|
).
|
|
|
|
% make_temp_file_and_open_it(WritePred, Result, !IO):
|
|
%
|
|
% Create a temporary file and call WritePred which will write data to it.
|
|
% If successful, return the file's name and a freshly opened input stream.
|
|
% On error, remove the temporary file.
|
|
%
|
|
:- pred make_temp_file_and_open_it(
|
|
pred(string, maybe_error, io, io)::in(pred(in, out, di, uo) is det),
|
|
maybe_error({string, text_input_stream})::out,
|
|
io::di, io::uo) is det.
|
|
|
|
make_temp_file_and_open_it(WritePred, Result, !IO) :-
|
|
io.file.make_temp_file(TempFileResult, !IO),
|
|
(
|
|
TempFileResult = ok(TempFileName),
|
|
WritePred(TempFileName, PredResult, !IO),
|
|
(
|
|
PredResult = ok,
|
|
io.open_input(TempFileName, OpenResult, !IO),
|
|
(
|
|
OpenResult = ok(Stream),
|
|
Result = ok({TempFileName, Stream})
|
|
;
|
|
OpenResult = error(Error),
|
|
Result = error(format("could not open `%s': %s",
|
|
[s(TempFileName), s(error_message(Error))])),
|
|
io.file.remove_file(TempFileName, _, !IO)
|
|
)
|
|
;
|
|
PredResult = error(ErrorMessage),
|
|
io.file.remove_file(TempFileName, _, !IO),
|
|
Result = error(ErrorMessage)
|
|
)
|
|
;
|
|
TempFileResult = error(Error),
|
|
Result = error(format("could not create temporary file: %s",
|
|
[s(error_message(Error))]))
|
|
).
|
|
|
|
:- pred read_specs_file(string::in, string::in, maybe_error::out,
|
|
io::di, io::uo) is det.
|
|
|
|
read_specs_file(SpecsFile, TermFile, Result, !IO) :-
|
|
read_specs_file_2(SpecsFile, TermFile, Problem, !IO),
|
|
( if Problem = "" then
|
|
Result = ok
|
|
else
|
|
Result = error(Problem)
|
|
).
|
|
|
|
:- pragma foreign_decl("C",
|
|
"
|
|
#include ""mercury_event_spec.h""
|
|
#include <stdio.h>
|
|
#include <fcntl.h>
|
|
|
|
MR_String read_specs_file_2(MR_AllocSiteInfoPtr alloc_id,
|
|
MR_String specs_file_name, MR_String term_file_name);
|
|
MR_String read_specs_file_3(MR_AllocSiteInfoPtr alloc_id,
|
|
MR_String specs_file_name, MR_String term_file_name,
|
|
int spec_fd);
|
|
MR_String read_specs_file_4(MR_AllocSiteInfoPtr alloc_id,
|
|
MR_String specs_file_name, MR_String term_file_name,
|
|
int spec_fd, size_t size, char *spec_buf);
|
|
").
|
|
|
|
:- pred read_specs_file_2(string::in, string::in, string::out,
|
|
io::di, io::uo) is det.
|
|
:- pragma no_determinism_warning(pred(read_specs_file_2/5)).
|
|
|
|
:- pragma foreign_proc("C",
|
|
read_specs_file_2(SpecsFileName::in, TermFileName::in, Problem::out,
|
|
_IO0::di, _IO::uo),
|
|
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
|
|
"
|
|
// We need to save/restore MR_hp so that we can allocate the return
|
|
// value on Mercury's heap if necessary.
|
|
MR_save_transient_hp();
|
|
Problem = read_specs_file_2(MR_ALLOC_ID, SpecsFileName, TermFileName);
|
|
MR_restore_transient_hp();
|
|
").
|
|
|
|
read_specs_file_2(_, _, Problem, !IO) :-
|
|
Problem = "mmc can read event set specifications only when it itself " ++
|
|
"is compiled in a grade that targets C code.".
|
|
|
|
:- pragma foreign_code("C", "
|
|
|
|
MR_String
|
|
read_specs_file_2(MR_AllocSiteInfoPtr alloc_id, MR_String specs_file_name,
|
|
MR_String term_file_name)
|
|
{
|
|
int spec_fd;
|
|
MR_String problem;
|
|
char errbuf[MR_STRERROR_BUF_SIZE];
|
|
|
|
// There are 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(specs_file_name, O_RDONLY);
|
|
if (spec_fd < 0) {
|
|
problem = MR_make_string(alloc_id, ""could not open %s: %s"",
|
|
specs_file_name, MR_strerror(errno, errbuf, sizeof(errbuf)));
|
|
} else {
|
|
problem = read_specs_file_3(alloc_id, specs_file_name,
|
|
term_file_name, spec_fd);
|
|
(void) close(spec_fd);
|
|
}
|
|
return problem;
|
|
}
|
|
|
|
MR_String
|
|
read_specs_file_3(MR_AllocSiteInfoPtr alloc_id, MR_String specs_file_name,
|
|
MR_String term_file_name, int spec_fd)
|
|
{
|
|
struct stat stat_buf;
|
|
MR_String problem;
|
|
|
|
if (fstat(spec_fd, &stat_buf) != 0) {
|
|
problem = MR_make_string(alloc_id, ""could not stat %s"",
|
|
specs_file_name);
|
|
} else {
|
|
char *spec_buf;
|
|
|
|
spec_buf = malloc(stat_buf.st_size + 1);
|
|
if (spec_buf == NULL) {
|
|
problem = MR_make_string(alloc_id,
|
|
""could not allocate memory for a copy of %s"",
|
|
specs_file_name);
|
|
} else {
|
|
problem = read_specs_file_4(alloc_id, specs_file_name,
|
|
term_file_name, spec_fd, stat_buf.st_size, spec_buf);
|
|
free(spec_buf);
|
|
}
|
|
}
|
|
return problem;
|
|
}
|
|
|
|
MR_String
|
|
read_specs_file_4(MR_AllocSiteInfoPtr alloc_id, MR_String specs_file_name,
|
|
MR_String term_file_name, int spec_fd, size_t size, char *spec_buf)
|
|
{
|
|
size_t num_bytes_read;
|
|
MR_String problem;
|
|
|
|
// XXX We don't handle successful but partial reads.
|
|
do {
|
|
num_bytes_read = read(spec_fd, spec_buf, size);
|
|
} while (num_bytes_read == -1 && MR_is_eintr(errno));
|
|
if (num_bytes_read != size) {
|
|
problem = MR_make_string(alloc_id, ""could not read in %s"",
|
|
specs_file_name);
|
|
} else {
|
|
MR_EventSet event_set;
|
|
|
|
// NULL terminate the string we have read in.
|
|
spec_buf[num_bytes_read] = '\\0';
|
|
event_set = MR_read_event_set(specs_file_name, spec_buf);
|
|
if (event_set == NULL) {
|
|
problem = MR_make_string(alloc_id, ""could not parse %s"",
|
|
specs_file_name);
|
|
} else {
|
|
FILE *term_fp;
|
|
char errbuf[MR_STRERROR_BUF_SIZE];
|
|
|
|
term_fp = fopen(term_file_name, ""w"");
|
|
if (term_fp == NULL) {
|
|
problem = MR_make_string(alloc_id, ""could not open %s: %s"",
|
|
term_file_name,
|
|
MR_strerror(errno, errbuf, sizeof(errbuf)));
|
|
} else {
|
|
MR_print_event_set(term_fp, event_set);
|
|
fclose(term_fp);
|
|
|
|
// Our caller tests Problem against the empty string, not NULL.
|
|
problem = MR_make_string(alloc_id, """");
|
|
}
|
|
}
|
|
}
|
|
return problem;
|
|
}
|
|
").
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type event_set_spec
|
|
---> event_set_spec(
|
|
event_set_name :: string,
|
|
event_set_specs :: list(event_spec_term)
|
|
).
|
|
|
|
:- type event_spec_term
|
|
---> event_spec_term(
|
|
event_name :: string,
|
|
event_num :: int,
|
|
event_linenumber :: int,
|
|
event_attrs :: list(event_attr_term)
|
|
).
|
|
|
|
:- type event_attr_term
|
|
---> event_attr_term(
|
|
attr_name :: string,
|
|
attr_linenum :: int,
|
|
attr_type :: event_attr_type
|
|
).
|
|
|
|
:- type event_attr_synth_call_term
|
|
---> event_attr_synth_call_term(
|
|
func_attr_name :: string,
|
|
arg_attr_names :: list(string)
|
|
).
|
|
|
|
:- type event_attr_function_kind
|
|
---> event_attr_pure_function
|
|
; event_attr_impure_function.
|
|
|
|
:- type event_attr_type
|
|
---> event_attr_type_ordinary(
|
|
event_attr_type_term
|
|
)
|
|
; event_attr_type_synthesized(
|
|
event_attr_type_term,
|
|
event_attr_synth_call_term
|
|
)
|
|
; event_attr_type_function(
|
|
event_attr_function_kind
|
|
).
|
|
|
|
:- 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 digraph_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,
|
|
0, map.init, _AttrNumMap, map.init, AttrNameMap,
|
|
map.init, AttrTypeMap0, bimap.init, KeyMap,
|
|
digraph.init, DepRel0, !ErrorSpecs),
|
|
build_dep_map(EventName, FileName, AttrNameMap, KeyMap, AttrTerms,
|
|
AttrTypeMap0, AttrTypeMap, DepRel0, DepRel, !ErrorSpecs),
|
|
convert_terms_to_attrs(EventName, FileName, AttrNameMap,
|
|
AttrTypeMap, 0, AttrTerms, [], RevAttrs, !ErrorSpecs),
|
|
( if
|
|
digraph.return_vertices_in_from_to_order(DepRel, AllAttrNameOrder)
|
|
then
|
|
% There is an order for computing the synthesized attributes.
|
|
keep_only_synth_attr_nums(AttrNameMap, AllAttrNameOrder,
|
|
SynthAttrNumOrder)
|
|
else
|
|
Context = term_context.context(FileName, EventLineNumber),
|
|
Sccs = digraph.return_sccs_in_to_from_order(DepRel),
|
|
list.filter(two_or_more_attrs_in_scc, Sccs, TooLargeSccs),
|
|
digraph.to_assoc_list(DepRel, DepRelEdges),
|
|
list.foldl(acc_self_dependent_nodes, DepRelEdges, [], RevSelfRecSccs),
|
|
list.reverse(RevSelfRecSccs, SelfRecSccs),
|
|
% Each scc in TooLargeSccs contains mutual recursion, while
|
|
% each scc in SelfRecSccs contains self recursion.
|
|
BadSccs = TooLargeSccs ++ SelfRecSccs,
|
|
(
|
|
BadSccs = [_ | _],
|
|
list.foldl(acc_circular_synth_attr_error(Context, EventName),
|
|
BadSccs, !ErrorSpecs)
|
|
;
|
|
BadSccs = [],
|
|
% Print an error message even if we can't blame a specific
|
|
% subset of the synthesized attributes.
|
|
acc_circular_synth_attr_error(Context, EventName,
|
|
set.init, !ErrorSpecs)
|
|
),
|
|
SynthAttrNumOrder = []
|
|
),
|
|
list.reverse(RevAttrs, Attrs),
|
|
EventSpec = event_spec(EventNumber, EventName, EventLineNumber,
|
|
Attrs, SynthAttrNumOrder),
|
|
( if map.search(!.EventSpecMap, EventName, OldEventSpec) then
|
|
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],
|
|
EventContext = term_context.context(FileName, EventLineNumber),
|
|
OldContext = term_context.context(FileName, OldLineNumber),
|
|
DuplErrorSpec = error_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
[simplest_msg(EventContext, Pieces1),
|
|
simplest_msg(OldContext, Pieces2)]),
|
|
!:ErrorSpecs = [DuplErrorSpec | !.ErrorSpecs]
|
|
else
|
|
map.det_insert(EventName, EventSpec, !EventSpecMap)
|
|
).
|
|
|
|
:- pred two_or_more_attrs_in_scc(set(string)::in) is semidet.
|
|
|
|
two_or_more_attrs_in_scc(Scc) :-
|
|
set.count(Scc) > 1.
|
|
|
|
:- pred acc_self_dependent_nodes(pair(string, string)::in,
|
|
list(set(string))::in, list(set(string))::out) is det.
|
|
|
|
acc_self_dependent_nodes(From - To, !RevSelfRecSccs) :-
|
|
( if From = To then
|
|
!:RevSelfRecSccs = [set.make_singleton_set(From) | !.RevSelfRecSccs]
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred acc_circular_synth_attr_error(prog_context::in, string::in,
|
|
set(string)::in, list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
acc_circular_synth_attr_error(Context, EventName, Scc, !ErrorSpecs) :-
|
|
Attrs = set.to_sorted_list(Scc),
|
|
(
|
|
Attrs = [_, _ | _],
|
|
Pieces =
|
|
[words("Synthesized attributes")] ++
|
|
list_to_quoted_pieces(set.to_sorted_list(Scc)) ++
|
|
[words("of event"), quote(EventName),
|
|
words("depend on each other."), nl]
|
|
;
|
|
Attrs = [Attr],
|
|
Pieces =
|
|
[words("Synthesized attribute"), quote(Attr),
|
|
words("of event"), quote(EventName),
|
|
words("depends on itself."), nl]
|
|
;
|
|
Attrs = [],
|
|
% This should never happen, as all circular dependencies
|
|
% should be classifiable as due to either mutual or self recursion,
|
|
% but just in case ...
|
|
Pieces =
|
|
[words("Circular dependency among the synthesized attributes"),
|
|
words("of event"), quote(EventName), suffix("."), nl]
|
|
),
|
|
CircErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree, Context, Pieces),
|
|
!:ErrorSpecs = [CircErrorSpec | !.ErrorSpecs].
|
|
|
|
:- pred keep_only_synth_attr_nums(attr_name_map::in, list(string)::in,
|
|
list(int)::out) is det.
|
|
|
|
keep_only_synth_attr_nums(_, [], []).
|
|
keep_only_synth_attr_nums(AttrMap, [AttrName | AttrNames], SynthAttrNums) :-
|
|
keep_only_synth_attr_nums(AttrMap, AttrNames, SynthAttrNumsTail),
|
|
map.lookup(AttrMap, AttrName, attr_info(AttrNum, _, _, AttrType)),
|
|
(
|
|
( AttrType = event_attr_type_ordinary(_)
|
|
; AttrType = event_attr_type_function(_)
|
|
),
|
|
SynthAttrNums = SynthAttrNumsTail
|
|
;
|
|
AttrType = event_attr_type_synthesized(_, _),
|
|
SynthAttrNums = [AttrNum | SynthAttrNumsTail]
|
|
).
|
|
|
|
:- type attr_info
|
|
---> attr_info(
|
|
attr_info_number :: int,
|
|
attr_info_name :: string,
|
|
attr_info_linenumber :: int,
|
|
attr_info_type :: event_attr_type
|
|
).
|
|
|
|
:- func attr_info_number(attr_info) = int.
|
|
|
|
% Given an attribute number, return information about that attribute.
|
|
:- type attr_num_map == map(int, attr_info).
|
|
|
|
% Given an attribute name, return information about that attribute.
|
|
:- type attr_name_map == map(string, attr_info).
|
|
|
|
% Given an attribute number, return that attribute's type.
|
|
:- type attr_type_map == map(string, mer_type).
|
|
|
|
% The dependency relation has a node for each attribute. The links between
|
|
% nodes represent the dependency of one attribute on another.
|
|
%
|
|
% The attr_key_map maps the name of each attribute to its key in
|
|
% attr_dep_rel.
|
|
:- type attr_dep_rel == digraph(string).
|
|
:- type attr_key == digraph_key(string).
|
|
:- type attr_key_map == bimap(string, attr_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, int::in, attr_num_map::in, attr_num_map::out,
|
|
attr_name_map::in, attr_name_map::out,
|
|
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(_, _, _, [], _, !AttrNumMap, !AttrNameMap, !AttrTypeMap,
|
|
!KeyMap, !DepRel, !ErrorSpecs).
|
|
build_plain_type_map(EventName, FileName, EventLineNumber,
|
|
[AttrTerm | AttrTerms], AttrNum, !AttrNumMap, !AttrNameMap,
|
|
!AttrTypeMap, !KeyMap, !DepRel, !ErrorSpecs) :-
|
|
AttrTerm = event_attr_term(AttrName, AttrLineNumber, AttrTypeTerm),
|
|
AttrInfo = attr_info(AttrNum, AttrName, AttrLineNumber, AttrTypeTerm),
|
|
map.det_insert(AttrNum, AttrInfo, !AttrNumMap),
|
|
digraph.add_vertex(AttrName, AttrKey, !DepRel),
|
|
( if bimap.insert(AttrName, AttrKey, !KeyMap) then
|
|
map.det_insert(AttrName, AttrInfo, !AttrNameMap)
|
|
else
|
|
Pieces = [words("Event"), quote(EventName),
|
|
words("has more than one attribute named"),
|
|
quote(AttrName), suffix("."), nl],
|
|
ErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
term_context.context(FileName, EventLineNumber), Pieces),
|
|
!:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
|
|
),
|
|
(
|
|
( AttrTypeTerm = event_attr_type_ordinary(TypeTerm)
|
|
; AttrTypeTerm = event_attr_type_synthesized(TypeTerm, _SynthCall)
|
|
),
|
|
Type = convert_term_to_type(TypeTerm),
|
|
( if map.search(!.AttrTypeMap, AttrName, _OldType) then
|
|
% The error message has already been generated above.
|
|
true
|
|
else
|
|
map.det_insert(AttrName, Type, !AttrTypeMap)
|
|
)
|
|
;
|
|
AttrTypeTerm = event_attr_type_function(_)
|
|
),
|
|
build_plain_type_map(EventName, FileName, EventLineNumber, AttrTerms,
|
|
AttrNum + 1, !AttrNumMap, !AttrNameMap, !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,
|
|
attr_name_map::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, AttrNameMap, KeyMap, [AttrTerm | AttrTerms],
|
|
!AttrTypeMap, !DepRel, !ErrorSpecs) :-
|
|
AttrTerm = event_attr_term(AttrName, AttrLineNumber, AttrTypeTerm),
|
|
bimap.lookup(KeyMap, AttrName, AttrKey),
|
|
(
|
|
AttrTypeTerm = event_attr_type_synthesized(_TypeTerm, SynthCallTerm),
|
|
SynthCallTerm = event_attr_synth_call_term(FuncAttrName, ArgAttrNames),
|
|
record_arg_dependencies(EventName, FileName, AttrLineNumber, KeyMap,
|
|
AttrName, AttrKey, ArgAttrNames, !DepRel, [], AttrErrorSpecs),
|
|
(
|
|
AttrErrorSpecs = [_ | _],
|
|
% We still record the fact that FuncAttrName is used, to prevent
|
|
% us from generating error messages saying that it is unused.
|
|
map.det_insert(FuncAttrName, void_type, !AttrTypeMap),
|
|
!:ErrorSpecs = AttrErrorSpecs ++ !.ErrorSpecs
|
|
;
|
|
AttrErrorSpecs = [],
|
|
( if map.search(!.AttrTypeMap, AttrName, AttrType) then
|
|
ArgTypes = list.map(map.lookup(!.AttrTypeMap), ArgAttrNames),
|
|
( if
|
|
map.search(AttrNameMap, FuncAttrName, FuncAttrInfo),
|
|
FuncAttrInfo ^ attr_info_type =
|
|
event_attr_type_function(FuncAttrPurity)
|
|
then
|
|
(
|
|
FuncAttrPurity = event_attr_pure_function,
|
|
FuncPurity = purity_pure
|
|
;
|
|
FuncAttrPurity = event_attr_impure_function,
|
|
FuncPurity = purity_impure
|
|
),
|
|
construct_higher_order_func_type(FuncPurity, lambda_normal,
|
|
ArgTypes, AttrType, FuncAttrType),
|
|
( if
|
|
map.search(!.AttrTypeMap, FuncAttrName,
|
|
OldFuncAttrType)
|
|
then
|
|
( if FuncAttrType = OldFuncAttrType then
|
|
% AttrTypeMap already contains the correct info.
|
|
true
|
|
else
|
|
FuncAttrLine =
|
|
FuncAttrInfo ^ attr_info_linenumber,
|
|
% XXX Maybe we should give the types themselves.
|
|
Pieces = [words("Attribute"), quote(FuncAttrName),
|
|
words("is assigned inconsistent types"),
|
|
words("by synthesized attributes."), nl],
|
|
ErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
term_context.context(FileName, FuncAttrLine),
|
|
Pieces),
|
|
!:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
|
|
)
|
|
else
|
|
map.det_insert(FuncAttrName, FuncAttrType,
|
|
!AttrTypeMap)
|
|
)
|
|
else
|
|
Pieces = [words("Attribute"), quote(AttrName),
|
|
words("cannot be synthesized"),
|
|
words("by non-function attribute"),
|
|
quote(FuncAttrName), suffix("."), nl],
|
|
ErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
term_context.context(FileName, AttrLineNumber),
|
|
Pieces),
|
|
!:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
|
|
)
|
|
else
|
|
% The error message was already generated in the previous pass.
|
|
true
|
|
)
|
|
)
|
|
;
|
|
AttrTypeTerm = event_attr_type_ordinary(_TypeTerm)
|
|
;
|
|
AttrTypeTerm = event_attr_type_function(_)
|
|
),
|
|
build_dep_map(EventName, FileName, AttrNameMap, KeyMap, AttrTerms,
|
|
!AttrTypeMap, !DepRel, !ErrorSpecs).
|
|
|
|
:- pred record_arg_dependencies(string::in, string::in, int::in,
|
|
attr_key_map::in, string::in, attr_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, AttrLineNumber, KeyMap,
|
|
SynthAttrName, SynthAttrKey, [AttrName | AttrNames],
|
|
!DepRel, !ErrorSpecs) :-
|
|
( if bimap.search(KeyMap, AttrName, AttrKey) then
|
|
digraph.add_edge(AttrKey, SynthAttrKey, !DepRel)
|
|
else
|
|
Pieces = [words("Attribute"), quote(SynthAttrName),
|
|
words("of event"), quote(EventName),
|
|
words("uses nonexistent attribute"), quote(AttrName),
|
|
words("in its synthesis."), nl],
|
|
ErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
term_context.context(FileName, AttrLineNumber), Pieces),
|
|
!:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
|
|
),
|
|
record_arg_dependencies(EventName, FileName, AttrLineNumber, KeyMap,
|
|
SynthAttrName, SynthAttrKey, 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, attr_name_map::in,
|
|
attr_type_map::in, int::in, list(event_attr_term)::in,
|
|
list(event_attribute)::in, list(event_attribute)::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
convert_terms_to_attrs(_, _, _, _, _, [], !RevAttrs, !ErrorSpecs).
|
|
convert_terms_to_attrs(EventName, FileName, AttrNameMap,
|
|
AttrTypeMap, AttrNum, [AttrTerm | AttrTerms], !RevAttrs,
|
|
!ErrorSpecs) :-
|
|
AttrTerm = event_attr_term(AttrName, AttrLineNumber, AttrTypeTerm),
|
|
(
|
|
AttrTypeTerm = event_attr_type_ordinary(_),
|
|
map.lookup(AttrTypeMap, AttrName, AttrType),
|
|
EventAttr = event_attribute(AttrNum, AttrName, AttrType, in_mode, no),
|
|
!:RevAttrs = [EventAttr | !.RevAttrs]
|
|
;
|
|
AttrTypeTerm = event_attr_type_synthesized(_, SynthCallTerm),
|
|
map.lookup(AttrTypeMap, AttrName, AttrType),
|
|
SynthCallTerm = event_attr_synth_call_term(FuncAttrName, ArgAttrNames),
|
|
( if
|
|
FuncAttrInfo = map.search(AttrNameMap, FuncAttrName),
|
|
FuncAttrNum = FuncAttrInfo ^ attr_info_number,
|
|
list.map(map.search(AttrNameMap), ArgAttrNames, ArgAttrInfos)
|
|
then
|
|
ArgAttrNums = list.map(attr_info_number, ArgAttrInfos),
|
|
ArgAttrNameNums = assoc_list.from_corresponding_lists(ArgAttrNames,
|
|
ArgAttrNums),
|
|
compute_prev_synth_attr_order(AttrNameMap, AttrName,
|
|
set.init, set.init, _, PrevSynthAttrOrder),
|
|
SynthCall = event_attr_synth_call(FuncAttrName - FuncAttrNum,
|
|
ArgAttrNameNums, PrevSynthAttrOrder),
|
|
EventAttr = event_attribute(AttrNum, AttrName, AttrType, in_mode,
|
|
yes(SynthCall)),
|
|
!:RevAttrs = [EventAttr | !.RevAttrs]
|
|
else
|
|
% The error that caused the map search failure has already had
|
|
% an error message generated for it.
|
|
true
|
|
)
|
|
;
|
|
AttrTypeTerm = event_attr_type_function(_),
|
|
( if map.search(AttrTypeMap, AttrName, AttrType) then
|
|
EventAttr = event_attribute(AttrNum, AttrName, AttrType, in_mode,
|
|
no),
|
|
!:RevAttrs = [EventAttr | !.RevAttrs]
|
|
else
|
|
Pieces = [words("Event"), quote(EventName),
|
|
words("does not use the function attribute"),
|
|
quote(AttrName), suffix("."), nl],
|
|
ErrorSpec = simplest_spec($pred, severity_error,
|
|
phase_term_to_parse_tree,
|
|
term_context.context(FileName, AttrLineNumber), Pieces),
|
|
!:ErrorSpecs = [ErrorSpec | !.ErrorSpecs]
|
|
)
|
|
),
|
|
convert_terms_to_attrs(EventName, FileName, AttrNameMap, AttrTypeMap,
|
|
AttrNum + 1, AttrTerms, !RevAttrs, !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),
|
|
( if
|
|
Args = [],
|
|
builtin_type_name(BuiltinType, Name)
|
|
then
|
|
Type = builtin_type(BuiltinType)
|
|
else
|
|
SymName = string_to_sym_name(Name),
|
|
ArgTypes = list.map(convert_term_to_type, Args),
|
|
Type = defined_type(SymName, ArgTypes, kind_star)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred compute_prev_synth_attr_order(attr_name_map::in, string::in,
|
|
set(string)::in, set(string)::in, set(string)::out, list(int)::out) is det.
|
|
|
|
compute_prev_synth_attr_order(AttrNameMap, AttrName, Ancestors,
|
|
!AlreadyComputed, PrevSynthOrder) :-
|
|
( if set.member(AttrName, Ancestors) then
|
|
% There is a circularity among the dependencies, which means that
|
|
% PrevSynthOrder won't actually be used.
|
|
PrevSynthOrder = []
|
|
else
|
|
( if map.search(AttrNameMap, AttrName, AttrInfo) then
|
|
AttrTerm = AttrInfo ^ attr_info_type,
|
|
(
|
|
( AttrTerm = event_attr_type_ordinary(_)
|
|
; AttrTerm = event_attr_type_function(_)
|
|
),
|
|
PrevSynthOrder = []
|
|
;
|
|
AttrTerm = event_attr_type_synthesized(_, SynthCall),
|
|
SynthCall = event_attr_synth_call_term(FuncAttrName,
|
|
ArgAttrNames),
|
|
set.insert(AttrName, Ancestors, SubAncestors),
|
|
compute_prev_synth_attr_order_for_args(AttrNameMap,
|
|
[FuncAttrName | ArgAttrNames], SubAncestors,
|
|
!AlreadyComputed, SubPrevSynthOrder),
|
|
set.insert(AttrName, !AlreadyComputed),
|
|
% This append at the end makes our algorithm O(n^2),
|
|
% but since n will always be small, this doesn't matter.
|
|
AttrNum = AttrInfo ^ attr_info_number,
|
|
PrevSynthOrder = SubPrevSynthOrder ++ [AttrNum]
|
|
)
|
|
else
|
|
% An error has occurred somewhere, which means that
|
|
% PrevSynthOrder won't actually be used.
|
|
PrevSynthOrder = []
|
|
)
|
|
).
|
|
|
|
:- pred compute_prev_synth_attr_order_for_args(attr_name_map::in,
|
|
list(string)::in, set(string)::in, set(string)::in, set(string)::out,
|
|
list(int)::out) is det.
|
|
|
|
compute_prev_synth_attr_order_for_args(_AttrNameMap, [],
|
|
_Ancestors, !AlreadyComputed, []).
|
|
compute_prev_synth_attr_order_for_args(AttrNameMap, [ArgName | ArgNames],
|
|
Ancestors, !AlreadyComputed, PrevSynthOrder) :-
|
|
compute_prev_synth_attr_order(AttrNameMap, ArgName,
|
|
Ancestors, !AlreadyComputed, PrevSynthOrderArg),
|
|
compute_prev_synth_attr_order_for_args(AttrNameMap, ArgNames,
|
|
Ancestors, !AlreadyComputed, PrevSynthOrderArgs),
|
|
PrevSynthOrder = PrevSynthOrderArg ++ PrevSynthOrderArgs.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
derive_event_set_data(EventSet) = EventSetData :-
|
|
EventSet = event_set(EventSetName, EventSpecMap),
|
|
map.values(EventSpecMap, EventSpecList),
|
|
list.sort(compare_event_specs_by_num, EventSpecList, SortedEventSpecList),
|
|
EventDescStrings = list.map(describe_event_spec, SortedEventSpecList),
|
|
string.append_list(EventDescStrings, EventDescs),
|
|
Desc = "event set " ++ EventSetName ++ "\n" ++ EventDescs,
|
|
list.foldl(update_max_num_attr, EventSpecList, -1, MaxNumAttr),
|
|
EventSetData = event_set_data(EventSetName, Desc, SortedEventSpecList,
|
|
MaxNumAttr).
|
|
|
|
:- pred update_max_num_attr(event_spec::in, int::in, int::out) is det.
|
|
|
|
update_max_num_attr(Spec, !MaxNumAttr) :-
|
|
AllAttrs = Spec ^ event_spec_attrs,
|
|
list.length(AllAttrs, NumAttr),
|
|
!:MaxNumAttr = int.max(!.MaxNumAttr, NumAttr).
|
|
|
|
:- pred compare_event_specs_by_num(event_spec::in, event_spec::in,
|
|
comparison_result::out) is det.
|
|
|
|
compare_event_specs_by_num(SpecA, SpecB, Result) :-
|
|
compare(Result, SpecA ^ event_spec_num, SpecB ^ event_spec_num).
|
|
|
|
:- func describe_event_spec(event_spec) = string.
|
|
|
|
describe_event_spec(Spec) = Desc :-
|
|
Spec = event_spec(_EventNumber, EventName, _EventLineNumber,
|
|
Attrs, _SynthAttrNumOrder),
|
|
AttrDescs = string.join_list(",\n", list.map(describe_event_attr, Attrs)),
|
|
Desc = "event " ++ EventName ++ "(" ++ AttrDescs ++ ")\n".
|
|
|
|
:- func describe_event_attr(event_attribute) = string.
|
|
|
|
describe_event_attr(Attr) = Desc :-
|
|
Attr = event_attribute(_Num, Name, Type, _Mode, MaybeSynthCall),
|
|
TypeDesc = describe_attr_type(Type),
|
|
(
|
|
MaybeSynthCall = no,
|
|
SynthCallDesc = ""
|
|
;
|
|
MaybeSynthCall = yes(SynthCall),
|
|
SynthCall = event_attr_synth_call(FuncAttrNameNum, ArgAttrNameNums,
|
|
_Order),
|
|
ArgAttrDesc = string.join_list(", ", assoc_list.keys(ArgAttrNameNums)),
|
|
SynthCallDesc = " synthesized by " ++
|
|
fst(FuncAttrNameNum) ++ "(" ++ 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), $pred, "not kind_star"),
|
|
(
|
|
ArgTypes = [],
|
|
ArgTypeDescs = ""
|
|
;
|
|
ArgTypes = [_ | _],
|
|
ArgTypeDescs = "(" ++
|
|
string.join_list(", ", list.map(describe_attr_type, ArgTypes))
|
|
++ ")"
|
|
),
|
|
Desc = sym_name_to_string(SymName) ++ ArgTypeDescs
|
|
;
|
|
Type = builtin_type(BuiltinType),
|
|
builtin_type_name(BuiltinType, Desc)
|
|
;
|
|
Type = higher_order_type(_, _, _, _, _),
|
|
Desc = "function"
|
|
;
|
|
( Type = type_variable(_, _)
|
|
; Type = tuple_type(_, _)
|
|
; Type = apply_n_type(_, _, _)
|
|
; Type = kinded_type(_, _)
|
|
),
|
|
unexpected($pred, "type not constructed by prog_event")
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
event_number(EventSpecMap, EventName, EventNumber) :-
|
|
map.search(EventSpecMap, EventName, EventSpec),
|
|
EventNumber = EventSpec ^ event_spec_num.
|
|
|
|
event_attributes(EventSpecMap, EventName, Attributes) :-
|
|
map.search(EventSpecMap, EventName, EventSpec),
|
|
Attributes = EventSpec ^ event_spec_attrs.
|
|
|
|
event_arg_types(EventSpecMap, EventName, ArgTypes) :-
|
|
event_attributes(EventSpecMap, EventName, Attributes),
|
|
list.filter_map(project_event_arg_type, Attributes, ArgTypes).
|
|
|
|
event_arg_modes(EventSpecMap, EventName, ArgModes) :-
|
|
event_attributes(EventSpecMap, EventName, Attributes),
|
|
list.filter_map(project_event_arg_mode, Attributes, ArgModes).
|
|
|
|
:- pred project_event_arg_type(event_attribute::in, mer_type::out) is semidet.
|
|
|
|
project_event_arg_type(Attribute, Attribute ^ attr_type) :-
|
|
Attribute ^ attr_maybe_synth_call = no.
|
|
|
|
:- pred project_event_arg_mode(event_attribute::in, mer_mode::out) is semidet.
|
|
|
|
project_event_arg_mode(Attribute, Attribute ^ attr_mode) :-
|
|
Attribute ^ attr_maybe_synth_call = no.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module parse_tree.prog_event.
|
|
%-----------------------------------------------------------------------------%
|