[m-rev.] For review: Compiler feedback system.
Julien Fischer
juliensf at csse.unimelb.edu.au
Mon Jul 21 13:57:43 AEST 2008
On Sun, 20 Jul 2008, Paul Bone wrote:
> Estimated hours taken: 8
> Branches: main
>
> Introduce a feedback system and modify Jerome's implicit parallelism work to
> use it. Generic information can now be fed back into the compiler to aid with
> optimizations.
Include a little more detail about the feedback system in the log
message.
Separate out the first change from the second in the above, e.g.
Introduce a feedback system ...
Modify the implicity parallelism ...
> mdbcomp/feedback.m:
> Created a new module for the feedback system, types representing feedback
> information and predicates for reading and writing feedback files, and
> manipulating feedback information are defined here.
>
> mdbcomp/mdbcomp.m:
> Updated to include the mdbcomp/feedback.m in this library.
>
> mdbcomp/program_representation.m:
> Created a new type to describe a call. This is used by the current
> implicit parallelism implementation.
>
> deep_profiler/mdprof_feedback.m:
> Updated to use the new feedback system. The old feedback file code has
> been removed.
> --program-name option has been added, a program name must be provided to
> be included in the header of the feedback file.
> Conform to changes in mdbcomp/program_representation.m
>
> compiler/globals.m:
> Added feedback data to globals structure.
> Added predicates to get and set the feedback information stored in the
> globals structure.
> Modified predicates that create the globals structure.
>
> compiler/handle_options.m:
> Set feedback information in globals structure when it is created in
> postprocess_options.
> Read feedback information in from file in check_option_values.
> Code added to postprocess_options2 to check the usage of the
> --implicit-parallelism option.
>
> compiler/implicit_parallelism.m:
> This module no-longer reads the feedback file it's self, this code has
> been removed, as has the IO state.
> Information from the feedback state is retrieved and used to control
> implicit parallelism.
>
> compiler/mercury_compile.m:
> No-longer checks options for implicit parallelization, this is now done in
> compiler/handle_options.m.
> Conform to changes in implicit_parallelism.m
>
> deep_profiler/Mmakefile:
> slice/Mmakefile:
> Modified to include mdbcomp/feedback.m for compilation in this directory.
...
> Index: compiler/handle_options.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
> retrieving revision 1.320
> diff -u -p -r1.320 handle_options.m
> --- compiler/handle_options.m 2 Jun 2008 02:27:26 -0000 1.320
> +++ compiler/handle_options.m 20 Jul 2008 04:40:56 -0000
> @@ -81,6 +81,8 @@
> :- import_module analysis.
> :- import_module libs.compiler_util.
> :- import_module libs.trace_params.
> +:- import_module mdbcomp.
> +:- import_module mdbcomp.feedback.
> :- import_module parse_tree.
> :- import_module parse_tree.error_util.
>
> @@ -187,12 +189,12 @@ postprocess_options(error(ErrorMessage),
> postprocess_options(ok(OptionTable0), Errors, !IO) :-
> check_option_values(OptionTable0, OptionTable, Target, GC_Method,
> TagsMethod, TermNorm, Term2Norm, TraceLevel, TraceSuppress,
> - MaybeThreadSafe, C_CompilerType, [], CheckErrors),
> + MaybeThreadSafe, C_CompilerType, FeedbackState, [], CheckErrors, !IO),
> (
> CheckErrors = [],
> postprocess_options_2(OptionTable, Target, GC_Method,
> TagsMethod, TermNorm, Term2Norm, TraceLevel,
> - TraceSuppress, MaybeThreadSafe, C_CompilerType,
> + TraceSuppress, MaybeThreadSafe, C_CompilerType, FeedbackState,
> [], Errors, !IO)
> ;
> CheckErrors = [_ | _],
> @@ -203,12 +205,12 @@ postprocess_options(ok(OptionTable0), Er
> compilation_target::out, gc_method::out, tags_method::out,
> termination_norm::out, termination_norm::out, trace_level::out,
> trace_suppress_items::out, may_be_thread_safe::out,
> - c_compiler_type::out,
> - list(string)::in, list(string)::out) is det.
> + c_compiler_type::out, feedback_state::out,
> + list(string)::in, list(string)::out, io::di, io::uo) is det.
>
> check_option_values(!OptionTable, Target, GC_Method, TagsMethod,
> TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
> - C_CompilerType, !Errors) :-
> + C_CompilerType, FeedbackState, !Errors, !IO) :-
> map.lookup(!.OptionTable, target, Target0),
> (
> Target0 = string(TargetStr),
> @@ -354,6 +356,23 @@ check_option_values(!OptionTable, Target
> add_error("Invalid argument to option " ++
> "`--c-compiler-type'\n\t(must be" ++
> "`gcc', `lcc', `cl, or `unknown').", !Errors)
> + ),
> + map.lookup(!.OptionTable, feedback_file, FeedbackFile0),
> + (
> + FeedbackFile0 = string(FeedbackFile),
> + FeedbackFile \= ""
> + ->
> + feedback.read(FeedbackFile, FeedbackReadResult, !IO),
> + (
> + FeedbackReadResult = ok(FeedbackState)
> + ;
> + FeedbackReadResult = error(Error),
> + read_error_message_string(FeedbackFile, Error, ErrorMessage),
> + add_error(ErrorMessage, !Errors),
> + FeedbackState = feedback.init % Dummy.
> + )
> + ;
> + FeedbackState = feedback.init % No feedback info.
> ).
>
> :- pred add_error(string::in, list(string)::in, list(string)::out) is det.
> @@ -368,15 +387,15 @@ add_error(Error, Errors0, Errors) :-
> :- pred postprocess_options_2(option_table::in, compilation_target::in,
> gc_method::in, tags_method::in, termination_norm::in,
> termination_norm::in, trace_level::in, trace_suppress_items::in,
> - may_be_thread_safe::in, c_compiler_type::in,
> + may_be_thread_safe::in, c_compiler_type::in, feedback_state::in,
> list(string)::in, list(string)::out, io::di, io::uo) is det.
>
> postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
> TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
> - C_CompilerType, !Errors, !IO) :-
> + C_CompilerType, FeedbackState, !Errors, !IO) :-
> globals_io_init(OptionTable0, Target, GC_Method, TagsMethod0,
> TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
> - C_CompilerType, !IO),
> + C_CompilerType, FeedbackState, !IO),
>
> some [!Globals] (
> globals.io_get_globals(!:Globals, !IO),
> @@ -458,6 +477,53 @@ postprocess_options_2(OptionTable0, Targ
> globals.lookup_bool_option(!.Globals,
> automatic_intermodule_optimization, AutoIntermodOptimization),
>
> + % Implicit parallelism requires feedback information.
> + globals.lookup_bool_option(!.Globals, implicit_parallelism,
> + ImplicitParallelism),
> + (
> + ImplicitParallelism = yes,
> + globals.lookup_string_option(!.Globals, feedback_file,
> + FeedbackFile),
> + (
> + FeedbackFile = ""
> + ->
> + add_error("'--implicit-parallelism' requires '--feedback'",
> + !Errors)
> + ;
> + true
> + ),
> + % TODO: should 'implicit_parallism' imply 'parallel'?
No, --parallel is a component of the chosen grade. If I only enable
--implicit-parallelism for individual modules (e.g. by listing them
separately in a Mercury.options file) then those modules might be
compiled in a different grade.
> + globals.lookup_bool_option(!.Globals, parallel, Parallel),
> + (
> + Parallel = yes
> + ;
> + Parallel = no,
> + add_error("'--implicit_parallelism' requires '--parallel'",
> + !Errors)
> + ),
> + globals.lookup_bool_option(!.Globals, highlevel_code, HighLevelCode),
> + (
> + HighLevelCode = yes,
> + add_error("'--implicit-parallelism' is not compatible with "
> + ++ "'--highlevel-code'", !Errors)
> + ;
> + HighLevelCode = no
> + ),
> + (
> + Target = target_c
> + ;
> + ( Target = target_il
> + ; Target = target_java
> + ; Target = target_asm
> + ; Target = target_x86_64
> + ; Target = target_erlang ),
> + add_error("'--implicit-parallelism' is not compatible with "
> + ++ "target " ++ string(Target), !Errors)
> + )
> + ;
> + ImplicitParallelism = no
> + ),
> +
> % Generating IL implies:
> % - gc_method `automatic' and no heap reclamation on failure
> % Because GC is handled automatically by the .NET CLR
> Index: compiler/implicit_parallelism.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/implicit_parallelism.m,v
> retrieving revision 1.7
> diff -u -p -r1.7 implicit_parallelism.m
> --- compiler/implicit_parallelism.m 27 Feb 2008 07:23:07 -0000 1.7
> +++ compiler/implicit_parallelism.m 20 Jul 2008 04:40:56 -0000
> @@ -7,7 +7,7 @@
I only skimmed this file -- since you are going to rewrite it anyway,
things are fine now so long as they don't break anything else.
...
> Index: deep_profiler/mdprof_feedback.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/mdprof_feedback.m,v
> retrieving revision 1.4
> diff -u -p -r1.4 mdprof_feedback.m
> --- deep_profiler/mdprof_feedback.m 17 Feb 2008 06:48:38 -0000 1.4
> +++ deep_profiler/mdprof_feedback.m 20 Jul 2008 04:40:56 -0000
> @@ -1,13 +1,13 @@
> %-----------------------------------------------------------------------------%
> % vim: ft=mercury ts=4 sw=4 et
> %-----------------------------------------------------------------------------%
> -% Copyright (C) 2006-2007 The University of Melbourne.
> +% Copyright (C) 2006-2008 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: mdprof_feedback.m.
> -% Author: tannier.
> +% Author: tannier, pbone.
> %
> % This module contains the code for writing to a file the CSSs whose CSDs'
> % average/median call sequence counts (own and desc) exceed the given threshold.
> @@ -32,6 +32,9 @@
>
> :- import_module conf.
> :- import_module dump.
> +:- import_module mdbcomp.
> +:- import_module mdbcomp.feedback.
> +:- import_module mdbcomp.program_representation.
> :- import_module measurements.
> :- import_module profile.
> :- import_module startup.
> @@ -59,9 +62,14 @@ main(!IO) :-
> MaybeOptions = ok(Options),
> lookup_bool_option(Options, help, Help),
> lookup_bool_option(Options, version, Version),
> + lookup_string_option(Options, program_name, ProfileProgName0),
> + ProfileProgName = string.strip(ProfileProgName0),
> ( Version = yes ->
> write_version_message(ProgName, !IO)
> - ; Help = yes ->
> + ;
> + ( Help = yes
> + ; ProfileProgName = "" )
> + ->
> write_help_message(ProgName, !IO)
> ;
> ( Args = [Input, Output] ->
> @@ -81,8 +89,9 @@ main(!IO) :-
> MaybeProfile = ok(Deep),
> compute_css_list_above_threshold(0, Deep, Threshold,
> MeasureType, [], CSSListAboveThreshold),
> - generate_feedback_file(CSSListAboveThreshold, Deep,
> - MeasureType, Threshold, Output, !IO)
> + generate_feedback_file(CSSListAboveThreshold, Deep,
> + ProfileProgName, MeasureType, Threshold, Output,
> + !IO)
> ;
> MaybeProfile = error(Error),
> io.stderr_stream(Stderr, !IO),
> @@ -109,25 +118,32 @@ main(!IO) :-
>
> :- pred write_help_message(string::in, io::di, io::uo) is det.
>
> -write_help_message(ProgName) -->
> - io.format("Usage: %s [<options>] <input> <output>\n", [s(ProgName)]),
> - io.format("<input> must name a deep profiling data file.\n", []),
> - io.format("<output> is the file generated by this program.\n", []),
> - io.format("You may specify one of the following options:\n", []),
> - io.format("--help Generate this help message.\n", []),
> - io.format("--version Report the program's version number.\n", []),
> - io.format("--verbose Generate progress messages.\n", []),
> - io.format("--threshold <value>\n", []),
> - io.format(" Set the threshold to <value>.\n",[]),
> - io.format("--measure average|median\n",[]),
> - io.format(" average : Write to <output> the call sites\n",[]),
> - io.format(" static whose call sites dynamic's average\n",[]),
> - io.format(" call sequence counts exceed the given\n",[]),
> - io.format(" threshold (default option).\n",[]),
> - io.format(" median : Write to <output> the call sites\n",[]),
> - io.format(" static whose call sites dynamic's median\n",[]),
> - io.format(" call sequence counts exceed the given\n",[]),
> - io.format(" threshold.\n",[]).
> +write_help_message(ProgName, !IO) :-
> + Message0 = [
> + "Usage: %s --program-name <ProgName> [<options>] <input> <output>",
> + " <input> must name a deep profiling data file.",
> + " <output> is the file generated by this program.",
> + " You may specify the following options:",
> + " --help Generate this help message.",
> + " --version Report the program's version number.",
> + " --verbose Generate progress messages.",
> + " --threshold <value>",
> + " Set the threshold to <value>.",
> + " --measure average|median",
> + " average : Write to <output> the call sites",
> + " static whose call sites dynamic's average",
> + " call sequence counts exceed the given",
> + " threshold (default option).",
> + " median : Write to <output> the call sites",
> + " static whose call sites dynamic's median",
> + " call sequence counts exceed the given",
> + " threshold.",
> + " --program-name <name>",
> + " The name of the program that generated the",
> + " profiling data. This is stored in the",
> + " feedback file"],
> + string.join_list("\n", Message0) = Message,
> + io.format(Message, [s(ProgName)], !IO).
>
> :- pred write_version_message(string::in, io::di, io::uo) is det.
>
> @@ -165,7 +181,7 @@ read_deep_file(Input, Verbose, DumpStage
> % exceed the given threshold.
> %
> :- pred compute_css_list_above_threshold(int::in, deep::in, int::in,
> - measure_type::in, list(call_site_static)::in,
> + stat_measure::in, list(call_site_static)::in,
> list(call_site_static)::out) is det.
>
> compute_css_list_above_threshold(Index, Deep, Threshold, Measure,
> @@ -183,13 +199,13 @@ compute_css_list_above_threshold(Index,
> Callseqs = 0
> ;
> (
> - Measure = average,
> + Measure = stat_average,
> list.foldr(sum_callseqs_csd_ptr(Deep), CSDList,
> 0, SumCallseqs),
> % NOTE: we have checked that NumCSD is not zero above.
> Callseqs = SumCallseqs // NumCSD
> ;
> - Measure = median,
> + Measure = stat_median,
> list.sort(compare_csd_ptr(Deep), CSDList, CSDListSorted),
> IndexMedian = NumCSD // 2,
> list.index0_det(CSDListSorted, IndexMedian, MedianPtr),
> @@ -232,66 +248,64 @@ compare_csd_ptr(Deep, CSDPtrA, CSDPtrB,
> % average/median call sequence counts (own and desc) exceed the given
> % threshold.
> %
> -:- pred generate_feedback_file(list(call_site_static)::in, deep::in,
> - measure_type::in, int::in, string::in, io::di, io::uo) is det.
> -
> -generate_feedback_file(CSSList, Deep, Measure, Threshold, Output, !IO) :-
> - io.open_output(Output, Result, !IO),
> +:- pred generate_feedback_file(list(call_site_static)::in, deep::in, string::in,
> + stat_measure::in, int::in, string::in, io::di, io::uo) is det.
> +
> +generate_feedback_file(CSSList, Deep, ProgName, StatMeasure, Threshold, Output,
> + !IO) :-
> + some [!Feedback]
> (
> - Result = io.error(Err),
> - io.stderr_stream(Stderr, !IO),
> - io.write_string(Stderr, io.error_message(Err) ++ "\n", !IO)
> + feedback.read_or_create(Output, !:Feedback, !IO),
> + map(css_to_call(Deep), CSSList, Calls),
> + FeedbackInfo = feedback_info_calls_above_threshold_sorted(Threshold,
> + StatMeasure, Calls),
> + FeedbackInfoType = feedback_info_calls_above_threshold_sorted,
> + feedback.put(FeedbackInfoType, FeedbackInfo, !Feedback),
> + feedback.write(Output, ProgName, !.Feedback, WriteResult, !IO)
> + ),
> + (
> + WriteResult = ok
> ;
> - Result = ok(Stream),
> - io.write_string(Stream, "Profiling feedback file\n", !IO),
> - io.write_string(Stream, "Version = 1.0\n", !IO),
> - (
> - Measure = average,
> - io.write_string(Stream, "Measure = average\n", !IO)
> - ;
> - Measure = median,
> - io.write_string(Stream, "Measure = median\n", !IO)
> - ),
> - io.format(Stream, "Threshold = %i\n", [i(Threshold)], !IO),
> - write_css_list(CSSList, Deep, Stream, !IO),
> - io.close_output(Stream, !IO)
> + ( WriteResult = open_error(Error)
> + ; WriteResult = write_error(Error) ),
> + io.error_message(Error, ErrorMessage),
> + io.format("%s: %s\n", [s(Output), s(ErrorMessage)], !IO),
> + io.set_exit_status(1, !IO)
> ).
>
> % Write to the output the list of CSSs.
> %
> -:- pred write_css_list(list(call_site_static)::in, deep::in, output_stream::in,
> - io::di, io::uo) is det.
> +:- pred css_to_call(deep::in, call_site_static::in, call::out) is det.
>
> -write_css_list([], _, _, !IO).
> -write_css_list([ CSS | CSSList0 ], Deep, OutStrm, !IO) :-
> -
> - % Print the caller.
> - lookup_proc_statics(Deep ^ proc_statics, CSS ^ css_container, Caller),
> - io.write_string(OutStrm, Caller ^ ps_raw_id ++ " ", !IO),
> -
> - % Print the slot number of the CSS.
> - io.write_int(OutStrm, CSS ^ css_slot_num, !IO),
> - io.write_string(OutStrm, " ", !IO),
> +css_to_call(Deep, CSS, Call) :-
> + % Get the caller.
> + lookup_proc_statics(Deep ^ proc_statics, CSS ^ css_container, CallerPS),
> + Caller = CallerPS ^ ps_id,
> +
> + % Get the slot number.
> + Slot = CSS ^ css_slot_num,
>
> - % Print the callee.
> + % Get the Callee and Call Type.
> (
> CSS ^ css_kind = normal_call_and_callee(PSPtr, _),
> - lookup_proc_statics(Deep ^ proc_statics, PSPtr, Callee),
> - io.format(OutStrm, "normal_call %s\n", [s(Callee ^ ps_raw_id)], !IO)
> + lookup_proc_statics(Deep ^ proc_statics, PSPtr, CalleePS),
> + CallTypeAndCallee = plain_call(CalleePS ^ ps_id)
> ;
> CSS ^ css_kind = special_call_and_no_callee,
> - io.write_string(OutStrm, "special_call\n", !IO)
> + CallTypeAndCallee = special_call
> ;
> CSS ^ css_kind = higher_order_call_and_no_callee,
> - io.write_string(OutStrm, "higher_order_call\n", !IO)
> + CallTypeAndCallee = higher_order_call
> ;
> CSS ^ css_kind = method_call_and_no_callee,
> - io.write_string(OutStrm, "method_call\n", !IO)
> + CallTypeAndCallee = method_call
> ;
> CSS ^ css_kind = callback_and_no_callee,
> - io.write_string(OutStrm, "callback\n", !IO)
> + CallTypeAndCallee = callback_call
> ),
> - write_css_list(CSSList0, Deep, OutStrm, !IO).
> +
> + % Build the call datastructure.
> + Call = call(Caller, Slot, CallTypeAndCallee).
>
> %-----------------------------------------------------------------------------%
>
> @@ -301,12 +315,14 @@ write_css_list([ CSS | CSSList0 ], Deep,
> ; verbose
> ; version
> ; measure
> + ; program_name
> ; dump_stages
> ; dump_options.
>
> -:- type measure_type
> - ---> average
> - ; median.
> +% XXX: Moved to program_representation.
> +%:- type measure_type
> +% ---> average
> +% ; median.
In which case you should delete it here rather than leaving the
commented out copy lying about.
...
> Index: mdbcomp/feedback.m
> ===================================================================
> RCS file: mdbcomp/feedback.m
> diff -N mdbcomp/feedback.m
> --- /dev/null 1 Jan 1970 00:00:00 -0000
> +++ mdbcomp/feedback.m 20 Jul 2008 04:40:56 -0000
> @@ -0,0 +1,416 @@
> +%-----------------------------------------------------------------------------%
> +% vim: ft=mercury ts=4 sw=4 et
> +%-----------------------------------------------------------------------------%
> +% Copyright (C) 2008 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: feedback.m.
> +% Main author: pbone.
> +%
> +% This module defines routines implementing a compiler feedback system. It
> +% should be complied into the compiler and any tools that write feedback data
> +% for use by the compiler.
I suggest:
This module defines data structures for representing feedback
information as well as procedures for reading and writing
feedback files. It is included in the compiler and in any tools that
generate feedback data.
> +%-----------------------------------------------------------------------------%
> +%-----------------------------------------------------------------------------%
> +
> +:- module mdbcomp.feedback.
> +
> +:- interface.
> +
> +:- import_module mdbcomp.program_representation.
> +
> +:- import_module int.
> +:- import_module io.
> +:- import_module list.
> +:- import_module maybe.
> +:- import_module string.
> +
> +%-----------------------------------------------------------------------------%
> +
> + % Feedback information is stored in this datatype when in memory.
> + %
> +:- type feedback_state.
I would rename this type to feedback_info. And the feedback_info type
below to feedback_data.
> +%-----------------------------------------------------------------------------%
> +
> + % This type is used as a key for the data that may be fed back into the
> + % complier. When making changes to this structure be sure to increment the
> + % file format version number towards the bottom of this file.
> + %
> +:- type feedback_info_type
> + ---> feedback_info_calls_above_threshold_sorted.
You should document the meaning of this constructor -- it will matter
later when more are added. (With my suggested renamings I would make
this just feedback_type.)
> +%-----------------------------------------------------------------------------%
> +
> + % This type stores the data that may be fed back into the compiler. Each
> + % constructor here corrisponds to a value of the above type. When making
s/corrisponds/corresponds/
> + % changes to this structure or structures in mdbcomp.program_representation
> + % be sure to increment the file format version number towards the bottom of
> + % this file.
> + %
> + % TODO: Somehow need to constrain the instantiations of this type so that
> + % they are always paired with instantitations of the above type, and
> + % hopefuly the complier can assert this.
> + %
> +:- type feedback_info
> + ---> feedback_info_calls_above_threshold_sorted(
> + threshold :: int,
> + stat_measure :: stat_measure,
> + calls :: list(call)
> + ).
> +
> +:- type stat_measure
> + ---> stat_average
> + ; stat_median.
I know you didn't name this but average is not a good name - it's not
precisely defined in the sense that the median is. By average here we
mean `arithemtic mean', do we not?
> +%-----------------------------------------------------------------------------%
> +
> + % put(InfoType, Info, !State)
> + %
> + % 'Put' feedback data into the feedback files. Data is stored based on
> + % the type of information being stored.
> + %
> + % Data loaded from file (not added with put) will be removed from the
> + % internal state when data for the same info type is added.
> + %
> +:- pred put(feedback_info_type::in, feedback_info::in,
> + feedback_state::in, feedback_state::out) is det.
> +
I would name these operations something other than put or get (which are
already used in the stdlib's queue and stream modules.), e.g.
{get, put}_feedback_info.
> +%-----------------------------------------------------------------------------%
> +
> + % get(InfoType, MaybeInfo, State).
> + %
> + % To query the feedback files 'get' will give a value for a given info type
> + % if it exists.
> + %
> +:- pred get(feedback_info_type::in, maybe(feedback_info)::out,
> + feedback_state::in) is det.
> +
> +%-----------------------------------------------------------------------------%
> +
> + % read(Path, FeedbackState, !IO)
> + %
> + % This predicate reads in feedback data from a specified file. It should
> + % be called once per compiler invokation, after this the feedback data is
s/invokation/invocation/
> + % kept in the generated feedback_state variable.
What does that last bit mean?
> +:- pred read(string::in, feedback_read_result(feedback_state)::out,
> + io::di, io::uo) is det.
> +
> +:- type feedback_read_result(T)
> + ---> ok(T)
> + ; error(feedback_read_error).
> +
> +:- type feedback_read_error
> + ---> open_error(io.error)
> + ; read_error(io.error)
> + ; parse_error(
> + message :: string,
> + line_no :: int)
> + ; unexpected_eof
> + ; incorrect_version
> + ; incorrect_first_line
> + ; incorrect_program_name.
> +
> +%-----------------------------------------------------------------------------%
> +
> + % read_error_message_string(File, Error, Message)
> + %
> + % Create a string describing the read error.
> + %
> +:- pred read_error_message_string(string::in, feedback_read_error::in,
> + string::out) is det.
> +
> +%-----------------------------------------------------------------------------%
> +
> + % Try to read in a feedback file, if the file doesn't exist create a new
> + % empty feedback state in memory.
> + %
> +:- pred read_or_create(string::in, feedback_state::out, io::di, io::uo) is det.
> +
> +%-----------------------------------------------------------------------------%
> +
> + % init = FeedbackState
> + %
> + % Create a new empty feedback state.
> + %
> +:- func init = feedback_state.
Likewise init is not a good name since many functions in the stdlib
already use this name.
> +%-----------------------------------------------------------------------------%
> +
> + % write(Path, ProgName, FeedbackState, FeedbackWriteResult, !IO)
> + %
> + % Write out the feedback data to a given file name.
> + %
> +:- pred write(string::in, string::in, feedback_state::in,
> + feedback_write_result::out, io::di, io::uo) is det.
> +
> +:- type feedback_write_result
> + ---> ok
> + ; open_error(io.error)
> + ; write_error(io.error).
> +
> +%-----------------------------------------------------------------------------%
> +%-----------------------------------------------------------------------------%
> +
> +:- implementation.
> +
> +:- import_module exception.
> +:- import_module map.
> +:- import_module svmap.
> +:- import_module unit.
> +:- import_module univ.
> +
> +%-----------------------------------------------------------------------------%
> +
> +:- type feedback_state
> + ---> feedback_state(map(feedback_info_type, feedback_info)).
> +
> +%-----------------------------------------------------------------------------%
> +
> +get(InfoType, MaybeInfo, State) :-
> + State = feedback_state(Map),
> + (
> + map.search(Map, InfoType, Info)
> + ->
> + MaybeInfo = yes(Info)
> + ;
> + MaybeInfo = no
> + ).
> +
> +%-----------------------------------------------------------------------------%
> +
> +put(InfoType, Info, !State) :-
> + some [!Map] (
> + !.State = feedback_state(!:Map),
> + svmap.set(InfoType, Info, !Map),
> + !:State = feedback_state(!.Map)
> + ).
> +
> +%-----------------------------------------------------------------------------%
> +
> +read(Path, ReadResultFeedbackState, !IO) :-
I suggest naming this read_feedback_file (and renaming write below to
write_feedback_file).
> + io.open_input(Path, IOResStream, !IO),
> + (
> + %
> + % Set the data file as the current stream and call read2.
> + %
> + IOResStream = ok(Stream),
> + some [!Result] (
> + %
> + % Read each part of the file and continue reading of this is
> + % succesful. read_cont takes care of this logic.
> + %
> + read_check_line(feedback_first_line, incorrect_first_line, Stream,
> + unit, !:Result, !IO),
> + maybe_read(
> + read_check_line(feedback_version, incorrect_version, Stream),
> + !Result, !IO),
> + maybe_read(
> + read_no_check_line(Stream),
> + !Result, !IO),
> + maybe_read(read_data(Stream), !Result, !IO),
> + ReadResultFeedbackState = !.Result
> + ),
> + io.close_input(Stream, !IO)
> + ;
> + IOResStream = error(ErrorCode),
> + ReadResultFeedbackState = error(open_error(ErrorCode))
> + ).
> +
> + % If the result so far is successful, call the colsure and return it's
> + % result. Otherwise return the accumulated result without calling the
> + % colsure.
> + %
> +:- pred maybe_read(pred(A, feedback_read_result(B), io, io),
> + feedback_read_result(A), feedback_read_result(B), io, io).
> +:- mode maybe_read(pred(in, out, di, uo) is det,
> + in, out, di, uo) is det.
> +
> +maybe_read(Pred, Result0, Result, !IO) :-
> + (
> + Result0 = ok(Acc),
> + Pred(Acc, Result, !IO)
> + ;
> + Result0 = error(Error),
> + Result = error(Error)
> + ).
> +
> + % Read and check a line of the file.
> + %
> +:- pred read_check_line(string::in, feedback_read_error::in,
> + io.input_stream::in, unit::in, feedback_read_result(unit)::out,
> + io::di, io::uo) is det.
> +
> +read_check_line(TestLine, NotMatchError, Stream, _, Result, !IO) :-
> + io.read_line_as_string(Stream, IOResultLine, !IO),
> + (
> + IOResultLine = ok(Line),
> + (
> + ( Line = TestLine
> + ; Line = TestLine ++ "\n")
> + ->
> + Result = ok(unit)
> + ;
> + Result = error(NotMatchError)
> + )
> + ;
> + IOResultLine = eof,
> + Result = error(unexpected_eof)
> + ;
> + IOResultLine = error(Error),
> + Result = error(read_error(Error))
> + ).
> +
> + % Read and don't check a line of the file.
> + %
> +:- pred read_no_check_line(io.input_stream::in, unit::in,
> + feedback_read_result(unit)::out, io::di, io::uo) is det.
> +
> +read_no_check_line(Stream, _, Result, !IO) :-
> + io.read_line_as_string(Stream, IOResultLine, !IO),
> + (
> + IOResultLine = ok(_),
> + Result = ok(unit)
> + ;
> + IOResultLine = eof,
> + Result = error(unexpected_eof)
> + ;
> + IOResultLine = error(Error),
> + Result = error(read_error(Error))
> + ).
> +
> + % Read the feedback data from the file.
> + %
> +:- pred read_data(io.input_stream::in, unit::in,
> + feedback_read_result(feedback_state)::out, io::di, io::uo) is det.
> +
> +read_data(Stream, _, Result, !IO) :-
> + io.read(Stream, ReadResultDataAssocList, !IO),
> + (
> + ReadResultDataAssocList = ok(DataAssocList),
> + map.det_insert_from_assoc_list(map.init, DataAssocList, Map),
> + Result = ok(feedback_state(Map))
> + ;
> + ReadResultDataAssocList = eof,
> + Result = error(unexpected_eof)
> + ;
> + ReadResultDataAssocList = error(Error, Line),
> + Result = error(parse_error(Error, Line))
> + ).
> +
> +%-----------------------------------------------------------------------------%
> +
> +read_or_create(Path, Feedback, !IO) :-
> + read(Path, ReadResultFeedback, !IO),
> + (
> + ReadResultFeedback = ok(Feedback)
> + ;
> + ReadResultFeedback = error(Error),
> + display_read_error(Path, Error, !IO),
> + Feedback = init
> + ).
> +
> +%-----------------------------------------------------------------------------%
> +
> +read_error_message_string(File, Error, Message) :-
> + (
> + ( Error = open_error(Code)
> + ; Error = read_error(Code) ),
> + error_message(Code, MessagePart)
> + ;
> + Error = parse_error(ParseMessage, Line),
> + MessagePart = ParseMessage ++ " on line " ++ string(Line)
> + ;
> + Error = unexpected_eof,
> + MessagePart = "Unexpected end of file"
> + ;
> + Error = incorrect_version,
> + MessagePart = "Incorrect file format version"
> + ;
> + Error = incorrect_first_line,
> + MessagePart = "Incorrect file format"
> + ;
> + Error = incorrect_program_name,
> + MessagePart = "Program name didn't match, is this the right feedback file?"
> + ),
> + string.format("%s: %s\n", [s(File), s(MessagePart)], Message).
> +
> +%-----------------------------------------------------------------------------%
> +
> +:- pred display_read_error(string::in, feedback_read_error::in,
> + io::di, io::uo) is det.
> +
> +display_read_error(File, Error, !IO) :-
> + read_error_message_string(File, Error, Message),
> + io.write_string(Message, !IO).
> +
> +%-----------------------------------------------------------------------------%
> +
> +init = feedback_state(map.init).
> +
> +%-----------------------------------------------------------------------------%
> +
> +write(Path, ProgName, Feedback, Res, !IO) :-
> + io.open_output(Path, OpenRes, !IO),
> + (
> + OpenRes = ok(Stream),
> + promise_equivalent_solutions [!:IO, ExcpRes]
> + try_io(write2(Stream, ProgName, Feedback), ExcpRes, !IO),
> + (
> + ExcpRes = succeeded(_),
> + Res = ok
> + ;
> + ExcpRes = exception(ExcpUniv),
> +
> + %
> + % If the exception is not a type we exected then re-throw it.
> + %
> + (
> + univ_to_type(ExcpUniv, Excp)
> + ->
> + Res = write_error(Excp)
> + ;
> + rethrow(ExcpRes)
> + )
> + )
> + ;
> + OpenRes = error(ErrorCode),
> + Res = open_error(ErrorCode)
> + ).
> +
> + % Write out the data. This is called by try IO to catch any exceptions
> + % that close_output and other predicates may throw.
> + %
> +:- pred write2(output_stream::in, string::in, feedback_state::in, unit::out,
> + io::di, io::uo) is det.
> +
> +write2(Stream, ProgName, Feedback, unit, !IO) :-
> + io.write_string(Stream, feedback_first_line, !IO),
> + io.nl(Stream, !IO),
> + io.write_string(Stream, feedback_version, !IO),
> + io.nl(Stream, !IO),
> + io.write_string(Stream, ProgName, !IO),
> + io.nl(Stream, !IO),
> + Feedback = feedback_state(Map),
> + map.to_assoc_list(Map, FeedbackList),
> + io.write(Stream, FeedbackList, !IO),
> + io.write_string(Stream, ".\n", !IO),
> + io.close_output(Stream, !IO).
> +
> +%-----------------------------------------------------------------------------%
> +
> +:- func feedback_first_line = string.
> +
> +feedback_first_line = "Mercury Complier Feedback".
s/Complier/Compiler/
> +:- func feedback_version = string.
> +
> +feedback_version = "1".
> +
> +%-----------------------------------------------------------------------------%
> +:- end_module mdbcomp.feedback.
> +%-----------------------------------------------------------------------------%
> Index: mdbcomp/program_representation.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
> retrieving revision 1.30
> diff -u -p -r1.30 program_representation.m
> --- mdbcomp/program_representation.m 19 Mar 2008 05:30:00 -0000 1.30
> +++ mdbcomp/program_representation.m 20 Jul 2008 04:40:56 -0000
> @@ -285,6 +285,30 @@
>
> %-----------------------------------------------------------------------------%
>
> +% These types are used to describe parts of a program. They are used by
"parts of a program" is a bit vague - they are used to describe call
sites are they not?
> +% mdbcomp.feedback
> +
> +
> + % Describe a call.
> + %
> +:- type call
> + ---> call(
> + caller :: string_proc_label,
> + slot :: int,
> + call_type_and_callee :: call_type_and_callee
> + ).
call/N is a Mercury builtin - I suggest calling this type and the
data constructor something else.
> +
> + % The type of call.
> + %
> +:- type call_type_and_callee
> + ---> callback_call
> + ; higher_order_call
> + ; method_call
> + ; plain_call(string_proc_label)
> + ; special_call.
What is the "_and_callee" bit referring to?
Julien.
--------------------------------------------------------------------------
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