[m-rev.] for post-commit review: eliminate more redundant work
Zoltan Somogyi
zs at csse.unimelb.edu.au
Tue Sep 8 13:21:51 AEST 2009
More compiler speedups for hlc grades by eliminating redundant work.
compiler/c_util.m:
c_util.set_line_num used to account for 7% of the compilation time
on training_cars_full.m, mostly because of unnecessary name mangling,
as well as repeated lookups of the line_numbers option.
After this diff, we don't mangle names that do not need to be mangled
(testing the need for mangling as rarely as possible), and we provide
a means for our caller to tell us that line numbers are required,
since in some cases they already know.
compiler/mlds_to_c.m:
Look up the value of the line_numbers option just once, and then
remember it.
Rename a predicate to avoid an ambiguity.
compiler/mlds.m:
The code of mercury_type_to_mlds_type could execute the same lookup
on the type definition table three times in a row, though this fact
was not apparent from the source code. In some circumstances, it
could also invoke general-purpose predicates that did several tests
even when it already knew their outcomes.
This diff avoids the redundant lookup and tests.
It also factors out some code into a separate predicate,
and notes the similarity of this predicate to one in foreign.m.
compiler/foreign.m:
Note the similarity of this code to code to mlds.m.
compiler/type_util.m:
Provide a version of classify_type that allows mlds.m to avoid
both redundant tests and redundant lookups of the type table.
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/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
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/c_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/c_util.m,v
retrieving revision 1.41
diff -u -b -r1.41 c_util.m
--- compiler/c_util.m 24 Aug 2009 07:29:41 -0000 1.41
+++ compiler/c_util.m 4 Sep 2009 07:11:36 -0000
@@ -30,20 +30,32 @@
%
% Line numbering
%
- % set_line_num(FileName, LineNum):
+ % set_line_num(FileName, LineNum, !IO):
%
- % Emit a #line directive to set the specified filename and linenumber
- % so that C compiler error messages etc. will refer to the correct location
- % in the original source file location.
+ % If the line_numbers option is set, emit a #line directive to set the
+ % specified filename and linenumber so that C compiler error messages
+ % will refer to the correct location in the original source file location.
%
:- pred set_line_num(string::in, int::in, io::di, io::uo) is det.
- % Emit a #line directive to cancel the effect of any previous #line
- % directives, so that C compiler error messages etc. will refer to the
- % appropriate location in the generated .c file.
+ % always_set_line_num(FileName, LineNum):
+ %
+ % As set_line_num, but always generate a #line directive, regardless of
+ % the setting of the line_numbers option.
+ %
+:- pred always_set_line_num(string::in, int::in, io::di, io::uo) is det.
+
+ % If the line_numbers option is set, emit a #line directive to cancel
+ % the effect of any previous #line directives, so that C compiler error
+ % messages will refer to the appropriate location in the generated .c file.
%
:- pred reset_line_num(io::di, io::uo) is det.
+ % As reset_line_num, but always generate a #line directive, regardless of
+ % the setting of the line_numbers option.
+ %
+:- pred always_reset_line_num(io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
%
% String and character handling
@@ -175,11 +187,18 @@
%-----------------------------------------------------------------------------%
%
% Line numbering.
+%
set_line_num(File, Line, !IO) :-
globals.io_lookup_bool_option(line_numbers, LineNumbers, !IO),
(
LineNumbers = yes,
+ always_set_line_num(File, Line, !IO)
+ ;
+ LineNumbers = no
+ ).
+
+always_set_line_num(File, Line, !IO) :-
(
Line > 0,
File \= ""
@@ -187,38 +206,100 @@
io.write_string("#line ", !IO),
io.write_int(Line, !IO),
io.write_string(" """, !IO),
- output_quoted_string(File, !IO),
+ can_print_directly(File, CanPrint, !IO),
+ (
+ CanPrint = yes,
+ io.write_string(File, !IO)
+ ;
+ CanPrint = no,
+ output_quoted_string(File, !IO)
+ ),
io.write_string("""\n", !IO)
;
reset_line_num(!IO)
- )
+ ).
+
+reset_line_num(!IO) :-
+ globals.io_lookup_bool_option(line_numbers, LineNumbers, !IO),
+ (
+ LineNumbers = yes,
+ always_reset_line_num(!IO)
;
LineNumbers = no
).
-reset_line_num(!IO) :-
+always_reset_line_num(!IO) :-
% We want to generate another #line directive to reset the C compiler's
% idea of what it is processing back to the file we are generating.
io.get_output_line_number(Line, !IO),
- io.output_stream_name(FileName, !IO),
- globals.io_lookup_bool_option(line_numbers, LineNumbers, !IO),
+ io.output_stream_name(File, !IO),
(
Line > 0,
- FileName \= "",
- LineNumbers = yes
+ File \= ""
->
io.write_string("#line ", !IO),
io.write_int(Line + 1, !IO),
io.write_string(" """, !IO),
- output_quoted_string(FileName, !IO),
+ can_print_directly(File, CanPrint, !IO),
+ (
+ CanPrint = yes,
+ io.write_string(File, !IO)
+ ;
+ CanPrint = no,
+ output_quoted_string(File, !IO)
+ ),
io.write_string("""\n", !IO)
;
true
).
+ % Decide whether the given string can be printed directly, using
+ % io.write_string, rather than output_quoted_string. The latter can take
+ % more than 7% of the compiler's runtime!
+ %
+:- pred can_print_directly(string::in, bool::out, io::di, io::uo) is det.
+
+can_print_directly(_, no, !IO).
+
+:- pragma foreign_proc("C",
+ can_print_directly(Str::in, CanPrintDirectly::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure],
+"{
+ static MR_String last_string;
+ static MR_bool last_can_print_directly;
+ MR_bool can_print_directly;
+ const char *s;
+ int len;
+
+ /* We cache the result of the last decision. */
+ if (Str == last_string) {
+ CanPrintDirectly = last_can_print_directly;
+ } else {
+ can_print_directly = MR_TRUE;
+
+ for (s = Str; *s != '\\0'; s++) {
+ if (! (isalnum(*s) || *s == '_' || *s == '/' || *s == '.')) {
+ can_print_directly = MR_FALSE;
+ printf(""XXX %d XXX\\n"", *s);
+ break;
+ }
+ }
+
+ len = s - Str;
+ if (len >= 512) {
+ can_print_directly = MR_FALSE;
+ }
+
+ CanPrintDirectly = can_print_directly;
+
+ last_string = Str;
+ last_can_print_directly = CanPrintDirectly;
+ }
+}").
+
%-----------------------------------------------------------------------------%
%
-% String and character handling
+% String and character handling.
%
output_quoted_string(S, !IO) :-
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.81
diff -u -b -r1.81 foreign.m
--- compiler/foreign.m 4 Sep 2009 02:27:50 -0000 1.81
+++ compiler/foreign.m 4 Sep 2009 08:30:27 -0000
@@ -544,17 +544,17 @@
type_to_ctor(Type, TypeCtor),
search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn)
->
- hlds_data.get_type_defn_body(TypeDefn, Body),
+ hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- Body = hlds_foreign_type(ForeignTypeBody),
+ TypeBody = hlds_foreign_type(ForeignTypeBody),
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody,
ForeignTypeName, _, Assertions),
ExportType = exported_type_foreign(ForeignTypeName, Assertions)
;
- ( Body = hlds_du_type(_, _, _, _, _, _, _, _)
- ; Body = hlds_eqv_type(_)
- ; Body = hlds_solver_type(_, _)
- ; Body = hlds_abstract_type(_)
+ ( TypeBody = hlds_du_type(_, _, _, _, _, _, _, _)
+ ; TypeBody = hlds_eqv_type(_)
+ ; TypeBody = hlds_solver_type(_, _)
+ ; TypeBody = hlds_abstract_type(_)
),
ExportType = exported_type_mercury(Type)
)
@@ -570,6 +570,10 @@
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
MaybeUserEqComp, Assertions) :-
+ % The body of this function is very similar to the function
+ % foreign_type_to_mlds_type in mlds.m.
+ % Any changes here may require changes there as well.
+
ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
MaybeErlang),
module_info_get_globals(ModuleInfo, Globals),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.176
diff -u -b -r1.176 mlds.m
--- compiler/mlds.m 4 Sep 2009 02:27:53 -0000 1.176
+++ compiler/mlds.m 4 Sep 2009 08:30:26 -0000
@@ -1835,12 +1835,37 @@
MLDSType = mlds_ptr_type(MLDSRefType)
;
module_info_get_type_table(ModuleInfo, TypeTable),
- search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
- hlds_data.get_type_defn_body(TypeDefn, Body),
- Body = hlds_foreign_type(ForeignTypeBody),
+ ( search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn) ->
+ hlds_data.get_type_defn_body(TypeDefn, TypeBody),
+ ( TypeBody = hlds_foreign_type(ForeignTypeBody) ->
+ MLDSType = foreign_type_to_mlds_type(ModuleInfo,
+ ForeignTypeBody)
+ ;
+ Category = classify_type_defn_body(TypeBody),
+ ExportedType = non_foreign_type(Type),
+ MLDSType = mercury_type(Type, Category, ExportedType)
+ )
+ ;
+ Category = classify_type_ctor(ModuleInfo, TypeCtor),
+ ExportedType = non_foreign_type(Type),
+ MLDSType = mercury_type(Type, Category, ExportedType)
+ )
+ )
+ ;
+ Category = ctor_cat_variable,
+ ExportedType = non_foreign_type(Type),
+ MLDSType = mercury_type(Type, Category, ExportedType)
+ ).
+
+:- func foreign_type_to_mlds_type(module_info, foreign_type_body) = mlds_type.
+
+foreign_type_to_mlds_type(ModuleInfo, ForeignTypeBody) = MLDSType :-
+ % The body of this function is very similar to the function
+ % foreign_type_body_to_exported_type in foreign.m.
+ % Any changes here may require changes there as well.
+
ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
- _MaybeErlang)
- ->
+ _MaybeErlang),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
@@ -1900,17 +1925,7 @@
unexpected(this_file,
"mercury_type_to_mlds_type: target erlang")
),
- MLDSType = mlds_foreign_type(ForeignType)
- ;
- classify_type(ModuleInfo, Type) = Category,
- ExportedType = to_exported_type(ModuleInfo, Type),
- MLDSType = mercury_type(Type, Category, ExportedType)
- )
- ;
- classify_type(ModuleInfo, Type) = Category,
- ExportedType = to_exported_type(ModuleInfo, Type),
- MLDSType = mercury_type(Type, Category, ExportedType)
- ).
+ MLDSType = mlds_foreign_type(ForeignType).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.240
diff -u -b -r1.240 mlds_to_c.m
--- compiler/mlds_to_c.m 2 Sep 2009 05:48:00 -0000 1.240
+++ compiler/mlds_to_c.m 4 Sep 2009 06:39:31 -0000
@@ -137,6 +137,7 @@
%
:- type mlds_to_c_opts
---> mlds_to_c_opts(
+ m2co_line_numbers :: bool,
m2co_auto_comments :: bool,
m2co_gcc_local_labels :: bool,
m2co_gcc_nested_functions :: bool,
@@ -151,6 +152,7 @@
:- func init_mlds_to_c_opts(globals) = mlds_to_c_opts.
init_mlds_to_c_opts(Globals) = Opts :-
+ globals.lookup_bool_option(Globals, line_numbers, LineNumbers),
globals.lookup_bool_option(Globals, auto_comments, Comments),
globals.lookup_bool_option(Globals, gcc_local_labels, GccLabels),
globals.lookup_bool_option(Globals, gcc_nested_functions, GccNested),
@@ -169,8 +171,9 @@
ProfileAny = no
),
globals.get_target(Globals, Target),
- Opts = mlds_to_c_opts(Comments, GccLabels, GccNested, HighLevelData,
- ProfileCalls, ProfileMemory, ProfileTime, ProfileAny, Target).
+ Opts = mlds_to_c_opts(LineNumbers, Comments, GccLabels, GccNested,
+ HighLevelData, ProfileCalls, ProfileMemory, ProfileTime, ProfileAny,
+ Target).
output_c_mlds(MLDS, Globals, Suffix, !IO) :-
% We output the source file before outputting the header, since the Mmake
@@ -950,9 +953,9 @@
mlds_output_pragma_export_func_name(Opts, ModuleName, Indent,
PragmaExport, !IO),
io.write_string("\n", !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("{\n", !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
mlds_output_pragma_export_defn_body(Opts, ModuleName,
MLDS_Name, MLDS_Signature, !IO),
io.write_string("}\n", !IO).
@@ -965,7 +968,7 @@
Export = ml_pragma_export(Lang, ExportName, _MLDSName, Signature, Context),
expect(unify(Lang, lang_c), this_file, "export to language other than C."),
Name = qual(ModuleName, module_qual, entity_export(ExportName)),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
% For functions exported using `pragma foreign_export',
% we use the default C calling convention.
CallingConvention = "",
@@ -1447,7 +1450,7 @@
),
% Now output the declaration for this mlds_defn.
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
mlds_output_decl_flags(Opts, Flags, forward_decl, Name, DefnBody, !IO),
mlds_output_decl_body(Opts, Indent,
qual(ModuleName, module_qual, Name), Context, DefnBody, !IO)
@@ -1533,7 +1536,7 @@
Separate = no
)
),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
mlds_output_decl_flags(Opts, Flags, definition, Name, DefnBody, !IO),
mlds_output_defn_body(Opts, Indent, qual(ModuleName, module_qual, Name),
Context, DefnBody, !IO).
@@ -1716,7 +1719,7 @@
mlds_output_defns(Opts, Indent + 1, no, ClassModuleName,
BasesAndMembers, !IO)
),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("};\n", !IO),
mlds_output_defns(Opts, Indent, yes, ClassModuleName, StaticMembers, !IO).
@@ -1778,7 +1781,7 @@
Defn = mlds_defn(Name, Context, _Flags, DefnBody),
(
DefnBody = mlds_data(Type, Initializer, _GCStatement),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
mlds_output_fully_qualified_name(
qual(EnumModuleName, type_qual, Name), !IO),
mlds_output_initializer(Opts, Type, Initializer, !IO)
@@ -1944,7 +1947,7 @@
FunctionBody = body_defined_here(Body),
io.write_string("\n", !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("{\n", !IO),
mlds_maybe_output_time_profile_instr(Opts, Context, Indent + 1, Name,
@@ -1954,7 +1957,7 @@
FuncInfo = func_info(Name, Signature),
mlds_output_statement(Opts, Indent + 1, FuncInfo, Body, !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("}\n", !IO) % end the function
).
@@ -2040,7 +2043,7 @@
Context, Arg, !IO) :-
Arg = mlds_argument(Name, Type, GCStatement),
QualName = qual(ModuleName, module_qual, Name),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
mlds_output_data_decl_ho(Opts, OutputPrefix, OutputSuffix, QualName, Type,
!IO),
mlds_output_gc_statement(Opts, Indent, QualName, GCStatement, "\n", !IO).
@@ -2784,7 +2787,7 @@
mlds_output_statement(Opts, Indent, FuncInfo, Statement, !IO) :-
Statement = statement(Stmt, Context),
- output_context(Context, !IO),
+ output_context_opts(Opts, Context, !IO),
(
Stmt = ml_stmt_atomic(AtomicStatement),
mlds_output_atomic_stmt(Opts, Indent, FuncInfo, AtomicStatement,
@@ -2816,7 +2819,7 @@
Defns = []
),
mlds_output_statements(Opts, Indent + 1, FuncInfo, Statements, !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("}\n", !IO)
;
Stmt = ml_stmt_while(Cond, LoopStatement, AtLeastOnce),
@@ -2834,7 +2837,7 @@
io.write_string("do\n", !IO),
mlds_output_statement(Opts, Indent + 1, FuncInfo, LoopStatement,
!IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("while (", !IO),
mlds_output_rval(Opts, Cond, !IO),
io.write_string(");\n", !IO)
@@ -2888,7 +2891,7 @@
mlds_output_statement(Opts, Indent + 1, FuncInfo, Then, !IO),
(
MaybeElse = yes(Else),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("else\n", !IO),
mlds_output_statement(Opts, Indent + 1, FuncInfo, Else, !IO)
;
@@ -2896,7 +2899,7 @@
)
;
Stmt = ml_stmt_switch(_Type, Val, _Range, Cases, Default),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("switch (", !IO),
mlds_output_rval(Opts, Val, !IO),
io.write_string(") {\n", !IO),
@@ -2907,7 +2910,7 @@
list.foldl(
mlds_output_switch_case(Opts, Indent + 1, FuncInfo, Context),
Cases, !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("}\n", !IO)
;
Stmt = ml_stmt_label(LabelName),
@@ -2946,9 +2949,9 @@
io.write_string(") {\n", !IO),
list.foldl2(mlds_output_computed_goto_label(Context, Indent), Labels,
0, _FinalCount, !IO),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("default: /*NOTREACHED*/ MR_assert(0);\n", !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("}\n", !IO)
;
Stmt = ml_stmt_call(Signature, FuncRval, MaybeObject, CallArgs,
@@ -2981,7 +2984,7 @@
% are different can be marked as tail calls if they are known
% to never return.)
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
Signature = mlds_func_signature(_, RetTypes),
CallerSignature = mlds_func_signature(_, CallerRetTypes),
(
@@ -3024,7 +3027,7 @@
),
CallerRetTypes = []
->
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("return;\n", !IO)
;
mlds_maybe_output_time_profile_instr(Opts, Context, Indent + 1,
@@ -3087,18 +3090,18 @@
mlds_output_statement(Opts, Indent, FuncInfo, SubStatement0, !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("goto ", !IO),
mlds_output_lval(Opts, Ref, !IO),
io.write_string("_done;\n", !IO),
- mlds_indent(Context, Indent - 1, !IO),
+ mlds_output_context_and_indent(Context, Indent - 1, !IO),
mlds_output_lval(Opts, Ref, !IO),
io.write_string(":\n", !IO),
mlds_output_statement(Opts, Indent, FuncInfo, Handler, !IO),
- mlds_indent(Context, Indent - 1, !IO),
+ mlds_output_context_and_indent(Context, Indent - 1, !IO),
mlds_output_lval(Opts, Ref, !IO),
io.write_string("_done:\t;\n", !IO)
@@ -3147,7 +3150,7 @@
mlds_output_statement(Opts, Indent + 1, FuncInfo, SubStatement,
!IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("else\n", !IO),
mlds_output_statement(Opts, Indent + 1, FuncInfo, Handler, !IO)
@@ -3158,7 +3161,7 @@
mlds_label::in, int::in, int::out, io::di, io::uo) is det.
mlds_output_computed_goto_label(Context, Indent, Label, Count0, Count, !IO) :-
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("case ", !IO),
io.write_int(Count0, !IO),
io.write_string(": goto ", !IO),
@@ -3179,7 +3182,7 @@
mlds_output_case_cond(Opts, Indent, Context, FirstCond, !IO),
list.foldl(mlds_output_case_cond(Opts, Indent, Context), LaterConds, !IO),
mlds_output_statement(Opts, Indent + 1, FuncInfo, Statement, !IO),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("break;\n", !IO).
:- pred mlds_output_case_cond(mlds_to_c_opts::in, indent::in, mlds_context::in,
@@ -3188,14 +3191,14 @@
mlds_output_case_cond(Opts, Indent, Context, Match, !IO) :-
(
Match = match_value(Val),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("case ", !IO),
mlds_output_rval(Opts, Val, !IO),
io.write_string(":\n", !IO)
;
Match = match_range(Low, High),
% This uses the GNU C extension `case <Low> ... <High>:'.
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("case ", !IO),
mlds_output_rval(Opts, Low, !IO),
io.write_string(" ... ", !IO),
@@ -3210,16 +3213,16 @@
mlds_output_switch_default(Opts, Indent, FuncInfo, Context, Default, !IO) :-
(
Default = default_is_unreachable,
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("default: /*NOTREACHED*/ MR_assert(0);\n", !IO)
;
Default = default_do_nothing
;
Default = default_case(Statement),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("default:\n", !IO),
mlds_output_statement(Opts, Indent + 1, FuncInfo, Statement, !IO),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("break;\n", !IO)
).
@@ -3238,7 +3241,7 @@
ProfileMemory = Opts ^ m2co_profile_calls,
(
ProfileMemory = yes,
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("MR_record_allocation(", !IO),
io.write_int(list.length(Args), !IO),
io.write_string(", ", !IO),
@@ -3277,7 +3280,7 @@
ProfileCalls = Opts ^ m2co_profile_calls,
(
ProfileCalls = yes,
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("MR_prof_call_profile(", !IO),
mlds_output_bracketed_rval(Opts, CalleeFuncRval, !IO),
io.write_string(", ", !IO),
@@ -3298,7 +3301,7 @@
ProfileTime = Opts ^ m2co_profile_time,
(
ProfileTime = yes,
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("MR_set_prof_current_proc(", !IO),
mlds_output_fully_qualified_name(Name, !IO),
io.write_string(");\n", !IO)
@@ -3366,7 +3369,7 @@
% forms of the variables inside Args all include "__".
BaseVarName = "base",
Base = ls_string(BaseVarName),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
mlds_output_type_prefix(Opts, Type, !IO),
io.write_string(" ", !IO),
io.write_string(BaseVarName, !IO),
@@ -3379,7 +3382,7 @@
globals.io_get_gc_method(GC_Method, !IO),
(
GC_Method = gc_accurate,
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("MR_GC_check();\n", !IO),
% For types which hold RTTI that will be traversed by the collector
% at GC-time, we need to allocate an extra word at the start,
@@ -3390,10 +3393,10 @@
NeedsForwardingSpace = type_needs_forwarding_pointer_space(Type),
(
NeedsForwardingSpace = yes,
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("/* reserve space for " ++
"GC forwarding pointer*/\n", !IO),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
io.write_string("MR_hp_alloc(1);\n", !IO)
;
NeedsForwardingSpace = no
@@ -3411,7 +3414,7 @@
mlds_maybe_output_heap_profile_instr(Opts, Context, Indent + 1, Args,
FuncName, MaybeCtorName, !IO),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
write_lval_or_string(Opts, Base, !IO),
io.write_string(" = ", !IO),
(
@@ -3469,7 +3472,7 @@
Base = ls_lval(_)
;
Base = ls_string(BaseVarName1),
- mlds_indent(Context, Indent + 1, !IO),
+ mlds_output_context_and_indent(Context, Indent + 1, !IO),
mlds_output_lval(Opts, Target, !IO),
io.write_string(" = ", !IO),
io.write_string(BaseVarName1, !IO),
@@ -3477,7 +3480,7 @@
),
mlds_output_init_args(Args, ArgTypes, Context, 0, Base, Tag,
Opts, Indent + 1, !IO),
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("}\n", !IO)
;
Statement = gc_check,
@@ -3525,14 +3528,14 @@
TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs),
(
MaybeUserContext = yes(UserContext),
- output_context(mlds_make_context(UserContext), !IO)
+ output_context_opts(Opts, mlds_make_context(UserContext), !IO)
;
MaybeUserContext = no,
- output_context(Context, !IO)
+ output_context_opts(Opts, Context, !IO)
),
io.write_string(CodeString, !IO),
io.write_string("\n", !IO),
- reset_context(!IO)
+ reset_context_opts(Opts, !IO)
;
TargetCode = raw_target_code(CodeString, _Attrs),
io.write_string(CodeString, !IO)
@@ -3622,7 +3625,7 @@
% (or perhaps a call to a constructor function) rather than using the
% MR_hl_field() macro.
- mlds_indent(Context, Indent, !IO),
+ mlds_output_context_and_indent(Context, Indent, !IO),
io.write_string("MR_hl_field(", !IO),
mlds_output_tag(Tag, !IO),
io.write_string(", ", !IO),
@@ -4212,14 +4215,41 @@
term.context_line(ProgContext, LineNumber),
c_util.set_line_num(FileName, LineNumber, !IO).
+:- pred output_context_opts(mlds_to_c_opts::in, mlds_context::in,
+ io::di, io::uo) is det.
+
+output_context_opts(Opts, Context, !IO) :-
+ LineNumbers = Opts ^ m2co_line_numbers,
+ (
+ LineNumbers = yes,
+ ProgContext = mlds_get_prog_context(Context),
+ term.context_file(ProgContext, FileName),
+ term.context_line(ProgContext, LineNumber),
+ c_util.always_set_line_num(FileName, LineNumber, !IO)
+ ;
+ LineNumbers = no
+ ).
+
:- pred reset_context(io::di, io::uo) is det.
reset_context(!IO) :-
c_util.reset_line_num(!IO).
-:- pred mlds_indent(mlds_context::in, indent::in, io::di, io::uo) is det.
+:- pred reset_context_opts(mlds_to_c_opts::in, io::di, io::uo) is det.
+
+reset_context_opts(Opts, !IO) :-
+ LineNumbers = Opts ^ m2co_line_numbers,
+ (
+ LineNumbers = yes,
+ c_util.always_reset_line_num(!IO)
+ ;
+ LineNumbers = no
+ ).
+
+:- pred mlds_output_context_and_indent(mlds_context::in, indent::in,
+ io::di, io::uo) is det.
-mlds_indent(Context, N, !IO) :-
+mlds_output_context_and_indent(Context, N, !IO) :-
output_context(Context, !IO),
mlds_indent(N, !IO).
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.200
diff -u -b -r1.200 type_util.m
--- compiler/type_util.m 4 Sep 2009 02:27:55 -0000 1.200
+++ compiler/type_util.m 4 Sep 2009 08:13:50 -0000
@@ -161,6 +161,10 @@
%
:- func classify_type_ctor(module_info, type_ctor) = type_ctor_category.
+ % Given a type_ctor's type_ctor_defn's body, determine what sort it is.
+ %
+:- func classify_type_defn_body(hlds_type_body) = type_ctor_category.
+
% Report whether it is OK to include a value of the given time
% in a heap cell allocated with GC_malloc_atomic.
%
@@ -684,13 +688,16 @@
%-----------------------------------------------------------------------------%
classify_type(ModuleInfo, VarType) = TypeCategory :-
- ( type_to_ctor_and_args(VarType, TypeCtor, _) ->
+ ( type_to_ctor(VarType, TypeCtor) ->
TypeCategory = classify_type_ctor(ModuleInfo, TypeCtor)
;
TypeCategory = ctor_cat_variable
).
classify_type_ctor(ModuleInfo, TypeCtor) = TypeCategory :-
+ % Please keep the code of this predicate in sync with the code of
+ % classify_type_ctor_and_defn.
+
TypeCtor = type_ctor(TypeSymName, Arity),
(
TypeSymName = unqualified(TypeName),
@@ -797,6 +804,43 @@
)
).
+classify_type_defn_body(TypeBody) = TypeCategory :-
+ % Please keep the code of this predicate in sync with the code of
+ % classify_type_ctor.
+ %
+ % Unlike classify_type_ctor, we don't have to (a) test for types that do
+ % not have definitions, or (b) look up the definition, since our caller has
+ % already done that.
+
+ (
+ TypeBody = hlds_du_type(_, _, _, DuTypeKind, _, _, _, _),
+ (
+ DuTypeKind = du_type_kind_mercury_enum,
+ TypeCategory = ctor_cat_enum(cat_enum_mercury)
+ ;
+ DuTypeKind = du_type_kind_foreign_enum(_),
+ TypeCategory = ctor_cat_enum(cat_enum_foreign)
+ ;
+ DuTypeKind = du_type_kind_direct_dummy,
+ TypeCategory = ctor_cat_user(cat_user_direct_dummy)
+ ;
+ DuTypeKind = du_type_kind_notag(_, _, _),
+ TypeCategory = ctor_cat_user(cat_user_notag)
+ ;
+ DuTypeKind = du_type_kind_general,
+ TypeCategory = ctor_cat_user(cat_user_general)
+ )
+ ;
+ % XXX We should be able to return more precise descriptions
+ % than this.
+ ( TypeBody = hlds_eqv_type(_)
+ ; TypeBody = hlds_foreign_type(_)
+ ; TypeBody = hlds_solver_type(_, _)
+ ; TypeBody = hlds_abstract_type(_)
+ ),
+ TypeCategory = ctor_cat_user(cat_user_general)
+ ).
+
%-----------------------------------------------------------------------------%
update_type_may_use_atomic_alloc(ModuleInfo, Type, !MayUseAtomic) :-
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/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: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/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: 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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
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 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