[m-dev.] for review: fix inter-module optimization bugs
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Feb 7 14:24:14 AEDT 2001
Estimated hours taken: 3
Fix bugs in `:- pragma import' and `:- pragma export' with
inter-module optimizaton reported by Peter Ross (bug #131069).
compiler/mercury_to_mercury.m:
The code to output `:- pragma import' declarations was
writing `:- pragma import(p(Arg1::in, Arg2::out), "imported")'.
The correct output is `:- pragma import(p(in, out), "imported")'.
compiler/mercury_compile.m:
For modules containing `:- pragma export' declarations, add
":- pragma c_header_code("#include ModuleName.h")." to
the `.opt' file so the C compiler can find the function
prototypes for Mercury predicates exported to C when
compiling the C code in the `.opt' file.
Write the `.h' file for a module when writing the `.opt' file
when using the LLDS backend to avoid trying to use the `.h' file
before it has been created.
tests/valid/Mmakefile:
tests/valid/intermod_pragma_import.m:
tests/valid/intermod_pragma_import2.m:
Test case.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.192
diff -u -u -r1.192 mercury_compile.m
--- compiler/mercury_compile.m 2001/02/05 06:55:32 1.192
+++ compiler/mercury_compile.m 2001/02/07 03:19:00
@@ -916,10 +916,56 @@
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
globals__io_lookup_bool_option(termination, Termination),
+ globals__io_get_target(Target),
+ globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
( { MakeOptInt = yes } ->
- intermod__write_optfile(HLDS0, HLDS1),
+ { module_info_name(HLDS0, ModuleName) },
+ { module_info_get_pragma_exported_procs(HLDS0,
+ PragmaExportedProcs) },
+ %
+ % If the module contains `:- pragma export' declarations,
+ % we need to include a
+ % `:- pragma foreign_decl(c, "#include ModuleName.h").'
+ % declaration in the `.opt' file so the C compiler
+ % can find the function declarations for the exported
+ % procedures.
+ %
+
+ (
+ { PragmaExportedProcs = [_|_] },
+ { Target = c },
+
+ % High-level code uses a different mechanism
+ % to handle `:- pragma export' which doesn't
+ % need any special treatment here.
+ { HighLevelCode = no }
+ ->
+ % XXX Normally with `--split-c-files,
+ % `get_header_file_include_string'
+ % will return "#include ../ModuleName.h"
+ % We can't explicitly look for `../ModuleName.h'
+ % here because the `.opt' file might be part
+ % of a library, so we need to use the
+ % include path to find the header file.
+ %
+ % I'm not sure why we ever explicitly need the `../'.
+ % The parent directory should always be in the
+ % include path.
+ { LookInParentDirectory = no },
+
+ get_header_file_include_string(ModuleName,
+ LookInParentDirectory, IncludeString),
+ { term__context_init(Context) },
+ { module_add_foreign_decl(c, IncludeString, Context,
+ HLDS0, HLDS0a) }
+ ;
+ { HLDS0a = HLDS0 }
+ ),
+
+ intermod__write_optfile(HLDS0a, HLDS1),
+
% If intermod_unused_args is being performed, run polymorphism,
% mode analysis and determinism analysis, then run unused_args
% to append the unused argument information to the `.opt.tmp'
@@ -927,6 +973,7 @@
( { IntermodArgs = yes ; Termination = yes } ->
mercury_compile__frontend_pass_2_by_phases(
HLDS1, HLDS2, FoundModeError),
+ { DonePolymorphism = yes `with_type` bool },
( { FoundModeError = no } ->
( { IntermodArgs = yes } ->
mercury_compile__maybe_unused_args(
@@ -936,19 +983,58 @@
),
( { Termination = yes } ->
mercury_compile__maybe_termination(
- HLDS3, Verbose, Stats, HLDS)
+ HLDS3, Verbose, Stats, HLDS4)
;
- { HLDS = HLDS3 }
+ { HLDS4 = HLDS3 }
)
;
io__set_exit_status(1),
- { HLDS = HLDS2 }
+ { HLDS4 = HLDS2 }
)
+ ;
+ { DonePolymorphism = no },
+ { HLDS4 = HLDS1 }
+ ),
+ (
+ { PragmaExportedProcs = [_|_] },
+ { Target = c },
+
+ % High-level code uses a different mechanism
+ % to handle `:- pragma export' which doesn't
+ % need any special treatment here.
+ { HighLevelCode = no }
+ ->
+ %
+ % If there are `:- pragma export' declarations
+ % in this module, we need to produce the
+ % `.h' file now, because users of the `.opt'
+ % file may need it.
+ %
+
+ (
+ { DonePolymorphism = yes },
+ { HLDS5 = HLDS4 }
+ ;
+ { DonePolymorphism = no },
+ % Ensure that polymorphism has adjusted the
+ % argument lists of procedures exported to C.
+ % XXX We should only process the
+ % exported predicates.
+ mercury_compile__maybe_polymorphism(HLDS4,
+ Verbose, Stats, HLDS5)
+ ),
+
+ % XXX We should only process the exported predicates.
+ mercury_compile__map_args_to_regs(HLDS5,
+ Verbose, Stats, HLDS),
+ { export__get_foreign_export_decls(HLDS,
+ Foreign_ExportDecls) },
+ export__produce_header_file(Foreign_ExportDecls,
+ ModuleName)
;
- { HLDS = HLDS1 }
+ { HLDS = HLDS4 }
),
- { module_info_name(HLDS, ModuleName) },
module_name_to_file_name(ModuleName, ".opt", yes, OptName),
update_interface(OptName),
touch_interface_datestamp(ModuleName, ".optdate")
@@ -2427,19 +2513,10 @@
{ C_HeaderCode = C_HeaderCode0 }
;
{ C_ExportDecls = [_|_] },
- module_name_to_file_name(ModuleName, ".h", no, HeaderFileName),
- globals__io_lookup_bool_option(split_c_files, SplitFiles),
- {
- SplitFiles = yes,
- string__append_list(
- ["#include ""../", HeaderFileName, """\n"],
- IncludeString)
- ;
- SplitFiles = no,
- string__append_list(
- ["#include """, HeaderFileName, """\n"],
- IncludeString)
- },
+ globals__io_lookup_bool_option(split_c_files,
+ HeaderInParentDirectory),
+ get_header_file_include_string(ModuleName,
+ HeaderInParentDirectory, IncludeString),
{ term__context_init(Context) },
{ Include = foreign_decl_code(c, IncludeString, Context) },
@@ -2449,6 +2526,24 @@
% first.
{ list__append(C_HeaderCode0, [Include], C_HeaderCode) }
).
+
+:- pred get_header_file_include_string(module_name, bool, string,
+ io__state, io__state).
+:- mode get_header_file_include_string(in, in, out, di, uo) is det.
+
+get_header_file_include_string(ModuleName, SplitFiles, IncludeString) -->
+ module_name_to_file_name(ModuleName, ".h", no, HeaderFileName),
+ {
+ SplitFiles = yes,
+ string__append_list(
+ ["#include ""../", HeaderFileName, """\n"],
+ IncludeString)
+ ;
+ SplitFiles = no,
+ string__append_list(
+ ["#include """, HeaderFileName, """\n"],
+ IncludeString)
+ }.
:- pred get_c_body_code(foreign_body_info, list(user_foreign_code)).
:- mode get_c_body_code(in, out) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.181
diff -u -u -r1.181 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2000/11/23 04:32:40 1.181
+++ compiler/mercury_to_mercury.m 2001/02/07 03:19:38
@@ -2223,15 +2223,38 @@
mercury_output_pragma_foreign_code(Attributes, PredName, PredOrFunc, Vars0,
VarSet, PragmaCode) -->
(
- { PragmaCode = import(_, _, _, _) }
- ->
- io__write_string(":- pragma import(")
- ;
- io__write_string(":- pragma foreign_code("),
- { foreign_language(Attributes, Lang) },
- mercury_output_foreign_language_string(Lang),
- io__write_string(", ")
- ),
+ { PragmaCode = import(C_Function, _, _, _) },
+ % The predicate or function arguments in a `:- pragma import'
+ % declaration are not named.
+ { ImportModes = list__map(
+ (func(pragma_var(_, _, ImportMode)) = ImportMode),
+ Vars0) },
+
+ mercury_output_pragma_import(PredName, PredOrFunc,
+ ImportModes, Attributes, C_Function)
+ ;
+ { PragmaCode = ordinary(_, _) },
+ mercury_output_pragma_foreign_code_2(Attributes, PredName,
+ PredOrFunc, Vars0, VarSet, PragmaCode)
+ ;
+ { PragmaCode = nondet(_, _, _, _, _, _, _, _, _) },
+ mercury_output_pragma_foreign_code_2(Attributes, PredName,
+ PredOrFunc, Vars0, VarSet, PragmaCode)
+ ).
+
+:- pred mercury_output_pragma_foreign_code_2(
+ pragma_foreign_code_attributes, sym_name,
+ pred_or_func, list(pragma_var), prog_varset,
+ pragma_foreign_code_impl, io__state, io__state).
+:- mode mercury_output_pragma_foreign_code_2(
+ in, in, in, in, in, in, di, uo) is det.
+
+mercury_output_pragma_foreign_code_2(Attributes, PredName, PredOrFunc, Vars0,
+ VarSet, PragmaCode) -->
+ io__write_string(":- pragma foreign_code("),
+ { foreign_language(Attributes, Lang) },
+ mercury_output_foreign_language_string(Lang),
+ io__write_string(", "),
mercury_output_sym_name(PredName),
{
PredOrFunc = predicate,
@@ -2288,10 +2311,9 @@
mercury_output_foreign_code_string(Shared),
io__write_string(")")
;
- { PragmaCode = import(Name, _, _, _) },
- io__write_string(""""),
- io__write_string(Name),
- io__write_string("""")
+ { PragmaCode = import(_, _, _, _) },
+ % This should be handle in mercury_output_pragma_foreign_code.
+ { error("mercury_output_pragma_foreign_code_2") }
),
io__write_string(").\n").
@@ -2445,9 +2467,9 @@
),
io__write_string(", "),
mercury_output_pragma_foreign_attributes(Attributes),
- io__write_string(", "),
+ io__write_string(", """),
io__write_string(C_Function),
- io__write_string(").\n").
+ io__write_string(""").\n").
:- pred mercury_output_pragma_export(sym_name, pred_or_func, list(mode),
string, io__state, io__state).
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.82
diff -u -u -r1.82 Mmakefile
--- tests/valid/Mmakefile 2001/01/21 03:01:12 1.82
+++ tests/valid/Mmakefile 2001/02/06 04:18:01
@@ -82,6 +82,7 @@
intermod_lambda.m \
intermod_nested_module.m \
intermod_nested_uniq.m \
+ intermod_pragma_import.m \
intermod_quote.m \
intermod_record.m \
intermod_test.m \
@@ -240,6 +241,8 @@
MCFLAGS-intermod_nested_module2 = --intermodule-optimization
MCFLAGS-intermod_nested_uniq = --intermodule-optimization
MCFLAGS-intermod_nested_uniq2 = --intermodule-optimization
+MCFLAGS-intermod_pragma_import = --intermodule-optimization
+MCFLAGS-intermod_pragma_import2 = --intermodule-optimization
MCFLAGS-intermod_quote = --intermodule-optimization
MCFLAGS-intermod_quote2 = --intermodule-optimization
MCFLAGS-intermod_record = --intermodule-optimization
Index: tests/valid/intermod_pragma_import.m
===================================================================
RCS file: intermod_pragma_import.m
diff -N intermod_pragma_import.m
--- /dev/null Wed Feb 7 14:19:57 2001
+++ intermod_pragma_import.m Wed Feb 7 12:25:25 2001
@@ -0,0 +1,13 @@
+:- module intermod_pragma_import.
+
+:- interface.
+
+:- pred q(T::in, int::out) is det.
+
+:- implementation.
+
+:- import_module intermod_pragma_import2.
+
+q(A, B) :-
+ implemented_as_pragma_import(A, B).
+
Index: tests/valid/intermod_pragma_import2.m
===================================================================
RCS file: intermod_pragma_import2.m
diff -N intermod_pragma_import2.m
--- /dev/null Wed Feb 7 14:19:57 2001
+++ intermod_pragma_import2.m Wed Feb 7 12:25:25 2001
@@ -0,0 +1,14 @@
+:- module intermod_pragma_import2.
+
+:- interface.
+
+:- pred implemented_as_pragma_import(T::in, int::out) is det.
+
+:- implementation.
+
+:- pred p(T::in, int::out) is det.
+
+p(_, 4).
+
+:- pragma import(implemented_as_pragma_import(in, out), "imported").
+:- pragma export(p(in, out), "imported").
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list