[m-rev.] diff: avoid redundant declaration code
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Oct 14 11:46:10 AEST 2005
compiler/llds_out.m:
Don't print out any given piece of foreign declaration code more than
once. With intermodule inlining, the redundant foreign_import_modules
the front end generates lead to the .mh files of library modules being
printed literally dozens of times.
It would be nice to avoid redundant foreign_import_modules in the first
place, but that is harder to do.
Zoltan.
cvs diff: Diffing .
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/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.262
diff -u -b -r1.262 llds_out.m
--- compiler/llds_out.m 5 Oct 2005 06:33:42 -0000 1.262
+++ compiler/llds_out.m 12 Oct 2005 02:50:21 -0000
@@ -1275,14 +1275,18 @@
io::di, io::uo) is det.
output_foreign_header_include_lines(Decls, !IO) :-
- list__foldl(output_foreign_header_include_line, Decls, !IO).
+ list__foldl2(output_foreign_header_include_line, Decls, set__init, _, !IO).
:- pred output_foreign_header_include_line(foreign_decl_code::in,
- io::di, io::uo) is det.
+ set(string)::in, set(string)::out, io::di, io::uo) is det.
-output_foreign_header_include_line(Decl, !IO) :-
+output_foreign_header_include_line(Decl, !AlreadyDone, !IO) :-
Decl = foreign_decl_code(Lang, _IsLocal, Code, Context),
( Lang = c ->
+ ( set__member(Code, !.AlreadyDone) ->
+ true
+ ;
+ set__insert(!.AlreadyDone, Code, !:AlreadyDone),
globals__io_lookup_bool_option(auto_comments, PrintComments, !IO),
(
PrintComments = yes,
@@ -1298,6 +1302,7 @@
io__write_string(Code, !IO),
io__write_string("\n", !IO),
output_reset_line_num(!IO)
+ )
;
error("output_user_foreign_code: unexpected: " ++
"foreign code other than C")
Index: compiler/prog_foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_foreign.m,v
retrieving revision 1.2
diff -u -b -r1.2 prog_foreign.m
--- compiler/prog_foreign.m 24 Mar 2005 13:33:34 -0000 1.2
+++ compiler/prog_foreign.m 12 Oct 2005 02:48:26 -0000
@@ -1,25 +1,27 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2005 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.
%-----------------------------------------------------------------------------%
-
+%
% This module defines predicate for interfacing with foreign languages.
% that are necessary for the frontend of the compiler to construct
% the list of items. The predicates in this module should not depend
% on the HLDS in any way. The predicates for interfacing with foreign
% languages that do depend on the HLDS are defined in foreign.m.
-
+%
% This module also contains the parts of the name mangler that are used
% by the frontend of the compiler.
-
+%
% Warning: any changes to the name mangling algorithms implemented in this
% module may also require changes to extras/dynamic_linking/name_mangle.m,
% profiler/demangle.m, util/mdemangle.c and compiler/name_mangle.m.
-
+%
% Main authors: trd, dgj.
% This code was originally part of the foreign module and was moved here.
-
+%
%-----------------------------------------------------------------------------%
:- module parse_tree.prog_foreign.
@@ -44,32 +46,39 @@
:- type foreign_decl_code
---> foreign_decl_code(
- foreign_language,
- foreign_decl_is_local,
- string,
- prog_context
+ fdecl_lang :: foreign_language,
+ fdecl_is_local :: foreign_decl_is_local,
+ fdecl_code :: string,
+ fdecl_context :: prog_context
).
:- type foreign_body_code
---> foreign_body_code(
- foreign_language,
- string,
- prog_context
+ fbody_lang :: foreign_language,
+ fbody_code :: string,
+ fbody_context :: prog_context
).
:- type foreign_export_defns == list(foreign_export).
:- type foreign_export_decls
---> foreign_export_decls(
- foreign_decl_info,
- list(foreign_export_decl)
+ fexp_decls_info :: foreign_decl_info,
+ fexp_decls_list :: list(foreign_export_decl)
).
:- type foreign_export_decl
---> foreign_export_decl(
- foreign_language, % language of the export
- string, % return type
- string, % function name
- string % argument declarations
+ fexp_decl_lang :: foreign_language,
+ % Language of the export.
+
+ fexp_decl_ret_type :: string,
+ % Return type.
+
+ fexp_decl_func_name :: string,
+ % Function name.
+
+ fexp_decl_arg_decls :: string
+ % Argument declarations.
).
% Some code from a `pragma foreign_code' declaration that is not
@@ -82,7 +91,7 @@
term__context % source code location
).
- % the code for `pragma export' is generated directly as strings
+ % The code for `pragma export' is generated directly as strings
% by export.m.
%
:- type foreign_export == string.
@@ -153,18 +162,16 @@
:- func foreign_type_language(foreign_language_type) = foreign_language.
+%-----------------------------------------------------------------------------%
%
% The following are the parts of the name mangler that are needed by
% the compiler frontend so that it can write out makefile fragments.
-%
- % Returns the name of the initialization function
- % for a given module.
+ % Returns the name of the initialization function for a given module.
%
:- func make_init_name(module_name) = string.
- % Returns the name of the Aditi-RL code constant
- % for a given module.
+ % Returns the name of the Aditi-RL code constant for a given module.
%
:- func make_rl_data_name(module_name) = string.
@@ -173,7 +180,7 @@
%
:- func sym_name_mangle(sym_name) = string.
- % Mangle an arbitrary name into a C etc identifier
+ % Mangle an arbitrary name into a C etc identifier.
%
:- func name_mangle(string) = string.
@@ -195,9 +202,8 @@
%-----------------------------------------------------------------------------%
-foreign_import_module_name(
- foreign_import_module(Lang, ForeignImportModule, _)) =
- ModuleName :-
+foreign_import_module_name(ImportModule) = ModuleName :-
+ ImportModule = foreign_import_module(Lang, ForeignImportModule, _),
(
Lang = c,
ModuleName = ForeignImportModule
@@ -213,8 +219,7 @@
Lang)
;
Lang = csharp,
- ModuleName = foreign_language_module_name(ForeignImportModule,
- Lang)
+ ModuleName = foreign_language_module_name(ForeignImportModule, Lang)
).
foreign_import_module_name(ModuleForeignImported, CurrentModule) =
@@ -261,15 +266,17 @@
%-----------------------------------------------------------------------------%
-foreign_language_module_name(M, L) = FM :-
+foreign_language_module_name(ModuleName, Lang) = FullyQualifiedModuleName :-
% Only succeed if this language generates external files.
- _ = foreign_language_file_extension(L),
+ _ = foreign_language_file_extension(Lang),
- Ending = "__" ++ simple_foreign_language_string(L) ++ "_code",
- ( M = unqualified(Name),
- FM = unqualified(Name ++ Ending)
- ; M = qualified(Module, Name),
- FM = qualified(Module, Name ++ Ending)
+ Ending = "__" ++ simple_foreign_language_string(Lang) ++ "_code",
+ (
+ ModuleName = unqualified(Name),
+ FullyQualifiedModuleName = unqualified(Name ++ Ending)
+ ;
+ ModuleName = qualified(Module, Name),
+ FullyQualifiedModuleName = qualified(Module, Name ++ Ending)
).
%-----------------------------------------------------------------------------%
@@ -278,7 +285,8 @@
foreign_language_file_extension(managed_cplusplus) = ".cpp".
foreign_language_file_extension(csharp) = ".cs".
foreign_language_file_extension(java) = ".java".
-foreign_language_file_extension(il) = _ :- fail.
+foreign_language_file_extension(il) = _ :-
+ fail.
%-----------------------------------------------------------------------------%
@@ -286,25 +294,25 @@
% interfaces, but if we added appropriate options we might want
% to do this later.
- % When compiling to C, C is always preferred over any other language.
prefer_foreign_language(_Globals, c, Lang1, Lang2) =
+ % When compiling to C, C is always preferred over any other language.
( Lang2 = c, not Lang1 = c ->
yes
;
no
).
- % When compiling to asm, C is always preferred over any other language.
prefer_foreign_language(_Globals, asm, Lang1, Lang2) =
+ % When compiling to asm, C is always preferred over any other language.
( Lang2 = c, not Lang1 = c ->
yes
;
no
).
+prefer_foreign_language(_Globals, il, Lang1, Lang2) = Comp :-
% Whe compiling to il, first we prefer il, then csharp, then
% managed_cplusplus, after that we don't care.
-prefer_foreign_language(_Globals, il, Lang1, Lang2) = Comp :-
PreferredList = [il, csharp, managed_cplusplus],
FindLangPriority = (func(L) = X :-
@@ -321,9 +329,9 @@
Comp = no
).
- % Nothing useful to do here, but when we add Java as a
- % foreign language, we should add it here.
prefer_foreign_language(_Globals, java, _Lang1, _Lang2) = no.
+ % Nothing useful to do here, but when we add Java as a foreign language,
+ % we should add it here.
%-----------------------------------------------------------------------------%
@@ -343,12 +351,11 @@
make_init_name(ModuleName) = InitName :-
MangledModuleName = sym_name_mangle(ModuleName),
- string__append_list(["mercury__", MangledModuleName, "__"], InitName).
+ InitName = "mercury__" ++ MangledModuleName ++ "__".
make_rl_data_name(ModuleName) = RLDataConstName :-
MangledModuleName = sym_name_mangle(ModuleName),
- string__append("mercury__aditi_rl_data__", MangledModuleName,
- RLDataConstName).
+ RLDataConstName = "mercury__aditi_rl_data__" ++ MangledModuleName.
sym_name_mangle(unqualified(Name)) =
name_mangle(Name).
@@ -357,20 +364,18 @@
MangledPlainName = name_mangle(PlainName),
MangledName = qualify_name(MangledModuleName, MangledPlainName).
-%
-% Warning: any changes to the name mangling algorithm here may also
-% require changes to extras/dynamic_linking/name_mangle.m,
-% profiler/demangle.m, util/mdemangle.c and compiler/name_mangle.m.
-%
-
name_mangle(Name) = MangledName :-
+ % Warning: any changes to the name mangling algorithm here may also
+ % require changes to extras/dynamic_linking/name_mangle.m,
+ % profiler/demangle.m, util/mdemangle.c and compiler/name_mangle.m.
+
( string__is_alnum_or_underscore(Name) ->
- % any names that start with `f_' are changed so that
- % they start with `f__', so that we can use names starting
- % with `f_' (followed by anything except an underscore)
- % without fear of name collisions
+ % Any names that start with `f_' are changed so that they start with
+ % `f__', so that we can use names starting with `f_' (followed by
+ % anything except an underscore) without fear of name collisions.
+
( string__append("f_", Suffix, Name) ->
- string__append("f__", Suffix, MangledName)
+ MangledName = "f__" ++ Suffix
;
MangledName = Name
)
@@ -385,17 +390,15 @@
( name_conversion_table(String, Name0) ->
Name = Name0
;
- Name0 = convert_to_valid_c_identifier_2(String),
- string__append("f", Name0, Name)
+ Name = "f" ++ convert_to_valid_c_identifier_2(String)
).
- % A table used to convert Mercury functors into
- % C identifiers. Feel free to add any new translations you want.
- % The C identifiers should start with "f_",
- % to avoid introducing name clashes.
- % If the functor name is not found in the table, then
- % we use a fall-back method which produces ugly names.
-
+ % A table used to convert Mercury functors into C identifiers.
+ % Feel free to add any new translations you want. The C identifiers
+ % should start with "f_", to avoid introducing name clashes. If the functor
+ % name is not found in the table, then we use a fall-back method which
+ % produces ugly names.
+ %
:- pred name_conversion_table(string::in, string::out) is semidet.
name_conversion_table("\\=", "f_not_equal").
@@ -415,23 +418,20 @@
name_conversion_table("[|]", "f_cons").
name_conversion_table("[]", "f_nil").
- % This is the fall-back method.
- % Given a string, produce a C identifier
- % for that string by concatenating the decimal
- % expansions of the character codes in the string,
- % separated by underlines.
- % The C identifier will start with "f_"; this predicate
- % constructs everything except the initial "f".
+ % This is the fall-back method. Given a string, produce a C identifier
+ % for that string by concatenating the decimal expansions of the character
+ % codes in the string, separated by underlines. The C identifier will
+ % start with "f_"; this predicate constructs everything except the initial
+ % "f".
%
% For example, given the input "\n\t" we return "_10_8".
-
+ %
:- func convert_to_valid_c_identifier_2(string) = string.
convert_to_valid_c_identifier_2(String) = Name :-
( string__first_char(String, Char, Rest) ->
- % XXX This will cause ABI incompatibilities between
- % compilers which are built in grades that have
- % different character representations.
+ % XXX This will cause ABI incompatibilities between compilers which are
+ % built in grades that have different character representations.
char__to_int(Char, Code),
string__int_to_string(Code, CodeString),
string__append("_", CodeString, ThisCharString),
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
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
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/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/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/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/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: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing 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
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
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: 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: 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: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
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: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list