[m-rev.] For review: Modify deep profiling tools to use new datastructures.

Paul Bone pbone at csse.unimelb.edu.au
Wed Jul 9 23:30:35 AEST 2008


For review by Julien or Zoltan as they assisted with the design.

Estimated Hours Taken: 60
Branches: main

Introduced intermediate data structures to mdprof_cgi.  This will make it
easier to extract deep profiling information for any new tools.  It also
enables other viewers for deep profiling data to more easily be developed.

New code making use of these data structures follows a pipeline pattern
as it is converted between the following data structures in this order:

    Deep -> Report -> Display -> HTML

This work is in progress and only a handful of deep profiler commands have
been converted to use the new data structures.  The old code has been kept for
reference and should be removed in the future.

deep_profiler/report.m:
	Created new module that defines a data structure for a deep profiler report.
	The new report data structure can be used to describe the content of a
	particular report.

deep_profiler/display.m:
	Created new module that defines a data structure for displaying deep
	profiler information.
	The new display data structure can be used to describe the structure and
	content shown when a user views a deep profiler report.

deep_profiler/data_types.m:
	Created new module defining data types to represent percentages, amounts
	of computer memory and time.

deep_profiler/query.m:
	Move memory_units type to data_types.m.
	Handling of the following deep profiler commands has been re-written to
	use the new data structures:
		deep_cmd_quit,
		deep_cmd_timeout,
		deep_cmd_restart,
		deep_cmd_menu,
		deep_cmd_top_procs

deep_profiler/create_report.m:
	Created new module for creating reports from the deep data structure.

deep_profiler/display_report.m:
	Created new module for converting a report structure to a display
	structure.

deep_profiler/html_format.m:
	Introduce new code to convert a display data structure into a string of
	HTML formatted text.
	Moved number formatting code to data_types.m.


Index: deep_profiler/html_format.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/html_format.m,v
retrieving revision 1.21
diff -u -p -u -p -r1.21 html_format.m
--- deep_profiler/html_format.m	18 Apr 2008 05:57:48 -0000	1.21
+++ deep_profiler/html_format.m	9 Jul 2008 12:49:47 -0000
@@ -7,11 +7,20 @@
 %-----------------------------------------------------------------------------%
 %
 % File: html_format.m.
-% Author: zs.
+% Author: zs, pbone.
 %
 % This module contains code that sets the format of the HTML tables
 % we generate for individual queries.
 %
+% This module makes many calls to string.append.  In the C backends
+% string.append is linear time over the length of both input strings when
+% called in in, in, out mode.  If we build a long string from many short
+% strings the cost will be quadratic.  It may be better to build a data
+% structure with cords to describe how strings should be appended and then
+% use calls to string.append_list at a final stage to construct a single
+% string from the cord of strings.  There are alternative approaches that
+% should reduce the final cost to linear.
+%
 %-----------------------------------------------------------------------------%
 
 :- module html_format.
@@ -21,6 +30,7 @@
 :- import_module profile.
 :- import_module query.
 :- import_module top_procs.
+:- import_module display.
 
 :- import_module bool.
 :- import_module list.
@@ -28,6 +38,16 @@
 
 %-----------------------------------------------------------------------------%
 
+    % Construct a complete HTML page from the given display structure.
+    %
+    % The first parameter is used to geather extra information from the deep
+    % profile, for example the name of the Deep.data file to build the URLs
+    % from.
+    %
+:- pred htmlize_display(deep::in, display::in, string::out) is det.
+
+%-----------------------------------------------------------------------------%
+
 :- func table_start(preferences) = string.
 :- func table_end(preferences) = string.
 
@@ -148,15 +168,562 @@
 
 :- implementation.
 
+:- import_module bool.
 :- import_module char.
+:- import_module exception.
 :- import_module float.
 :- import_module int.
+:- import_module map.
 :- import_module maybe.
 :- import_module require.
 :- import_module string.
+:- import_module svmap.
+
+:- import_module data_types.
+
+%-----------------------------------------------------------------------------%
+
+htmlize_display(Deep, display(MaybeTitle, Content), HTML) :-
+    maybe_title_to_title(Deep, MaybeTitle, Title),
+    deep_to_http_context(Deep, HTTPContext),
+    map_join_html("</div><div>", item_to_html(HTTPContext), Content, Body),
+    string.format(html_template, [s(Title), s(Body)], HTML).
+
+:- func html_template = string.
+html_template = 
+"<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN""
+""http://www.w3.org/TR/html4/strict.dtd"">
+<html>
+    <head>
+        <title>%s</title>
+        <style type=\"text/css\">
+            td.allocations
+            {
+                text-align: right;
+            }
+            td.callseqs
+            {
+                text-align: right;
+            }
+            td.memory
+            {
+                text-align: right;
+            }
+            td.number
+            {
+                text-align: right;
+            }
+            td.ordinal_rank 
+            { 
+                text-align: right;
+            }
+            td.port_counts
+            {
+                text-align: right;
+            }
+            td.proc
+            {
+                text-align: left;
+            }
+            td.ticks_and_times
+            {
+                text-align: right;
+            }
+            a.control 
+            { 
+                margin: 5px; 
+                text-decoration: none; 
+            }
+            table.menu
+            { 
+                border-style: none; 
+            }
+            table.top_procs 
+            { 
+                border-width: 1px 1px 1px 1px;
+                border-spacing: 2px;
+                border-style: outset outset outset outset;
+            }
+            table.top_procs th
+            {
+                border-width: 1px 1px 1px 1px;
+                padding: 3px 3px 3px 3px;
+                border-style: inset inset inset inset;
+            }
+            table.top_procs td
+            {
+                border-width: 1px 1px 1px 1px;
+                padding: 3px 3px 3px 3px;
+                border-style: inset inset inset inset;
+            }
+        </style>
+    </head>
+    <body>
+    <div>
+    %s
+    </div>
+    </body>
+</html>".
+
+%-----------------------------------------------------------------------------%
+    
+    % Convert a display item into a HTML snippet.
+    %
+:- pred item_to_html(http_context::in, display_item::in, string::out) is det.
+
+item_to_html(_, display_message(Message), HTML) :-
+    HTML = "<h3>" ++ Message ++ "</h3>\n".
+
+item_to_html(HTTPContext, display_table(Table), HTML) :-
+    table_to_html(HTTPContext, Table, HTML).
+
+item_to_html(HTTPContext, display_list(Class, MaybeTitle, Items), HTML) :-
+    (
+        MaybeTitle = yes(Title),
+        HTML0 = "<span id=""list_title"">" ++ Title ++ "</span>",
+        (
+            Class = list_class_vertical_bullets,
+            HTML1 = HTML0
+        ;
+            ( Class = list_class_horizontal
+            ; Class = list_class_vertical_no_bullets ),
+            HTML1 = HTML0 ++ "<br>"
+        )
+    ;
+        MaybeTitle = no,
+        HTML1 = ""
+    ),
+    (
+        Class = list_class_vertical_bullets,
+        Delim = "</li>\n<li>",
+        HTML2 = HTML1 ++ "<ul><li>"
+    ;
+        Class = list_class_vertical_no_bullets,
+        Delim = "<br>",
+        HTML2 = HTML1
+    ;
+        Class = list_class_horizontal,
+        Delim = " ",
+        HTML2 = HTML1
+    ),
+    map_join_html(Delim, item_to_html(HTTPContext), Items, HTMLTemp),
+    HTML3 = HTML2 ++ HTMLTemp,
+    (
+        Class = list_class_vertical_bullets,
+        HTML = HTML3 ++ "</li></ul>\n"
+    ;
+        Class = list_class_vertical_no_bullets,
+        HTML = HTML3 ++ "<br>\n"
+    ;
+        Class = list_class_horizontal,
+        HTML = HTML3 ++ "\n"
+    ).
+
+item_to_html(HTTPContext, display_command_link(DeepLink), HTML) :-
+    link_to_html(HTTPContext, DeepLink, HTML).
+
+%-----------------------------------------------------------------------------%
+% Table htmlization.
+%-----------------------------------------------------------------------------%
+
+    % The number of rows to be used for a table header.
+    %
+:- type table_header_rows
+    --->    one
+    ;       two.
+
+    % A mapping of column numbers to classes.
+    %
+:- type col_class_map == map(int, string).
+
+%-----------------------------------------------------------------------------%
+
+    % Create a HTML table entity from the given table description.
+    %
+:- pred table_to_html(http_context::in, table::in, string::out) is det.
+
+table_to_html(HTTPContext, table(Class, NumCols, MaybeHeader, Rows), HTML) :-
+    table_class_to_string(Class, ClassStr),
+    Open = "<table class=\"" ++ ClassStr ++ "\">\n",
+    Close = "</table>\n",
+    
+    % Build a header row.
+    (
+        MaybeHeader = yes(table_header(THCells)),
+        foldl3(table_header_num_rows_and_classmap, THCells, one, THNumRows,
+            0, _, map.init, ClassMap),
+        MaybeClassMap = yes(ClassMap),
+        map_join_html(table_header_cell_to_html_row_1(HTTPContext, THNumRows), 
+            THCells, HeaderHTML0),
+        HeaderHTML1 = "<tr>" ++ HeaderHTML0 ++ "</tr>\n",
+        (
+            THNumRows = one,
+            HeaderHTML2 = HeaderHTML1
+        ;
+            THNumRows = two,
+            map_join_html(table_header_cell_to_html_row_2(HTTPContext), THCells,
+                HeaderHTML11),
+            HeaderHTML2 = HeaderHTML1 ++ "<tr>" ++ HeaderHTML11 ++ "</tr>\n"
+        ),
+        HeaderHTML = HeaderHTML2 ++ 
+            format("<tr><td colspan=\"%d\"/></tr>\n", [i(NumCols)])
+    ;
+        MaybeHeader = no,
+        MaybeClassMap = no,
+        HeaderHTML = ""
+    ),
+
+    % Build the table rows.
+    map_join_html(table_row_to_html(HTTPContext, MaybeClassMap, NumCols), Rows,
+        RowsHTML),
+
+    % Construct the table.
+    HTML = Open ++ HeaderHTML ++ RowsHTML ++ Close.
+
+%-----------------------------------------------------------------------------%
+
+    % Return the HTML entity for a table header cell.
+    %
+:- pred table_header_cell_to_html_row_1(http_context::in, table_header_rows::in,
+    table_header_cell::in, string::out) is det.
+
+table_header_cell_to_html_row_1(HTTPContext, HeaderNumRows, Cell, HTML) :-
+    (
+        Cell = table_header_cell(Contents, Class),
+        (
+            HeaderNumRows = one,
+            RowSpan = "1"
+        ;
+            HeaderNumRows = two,
+            RowSpan = "2"
+        ),
+        ColSpan = "1",
+        table_data_to_string(HTTPContext, Contents, ContentsString)
+    ;
+        Cell = table_header_group(Title, SubHeaderCells, Class),
+        RowSpan = "1",
+        length(SubHeaderCells, NumSubHeaderCells),
+        ColSpan = string(NumSubHeaderCells),
+        ContentsString = Title    
+    ),
+
+    table_col_class_to_string(Class, ClassStr),
+    string.format("<th rowspan=\"%s\" colspan=\"%s\" class=\"%s\">", 
+        [s(RowSpan), s(ColSpan), s(ClassStr)], Open),
+    HTML = Open ++ ContentsString ++ "</th>".
+
+%-----------------------------------------------------------------------------%
+
+:- pred table_header_cell_to_html_row_2(http_context::in,
+    table_header_cell::in, string::out) is det.
+
+table_header_cell_to_html_row_2(_, table_header_cell(_, _), "").
+
+table_header_cell_to_html_row_2(HTTPContext,
+    table_header_group(_, Cells, Class), HTML) :-
+    map_join_html(compose(wrap_in_th_tags(Class), 
+        table_data_to_string(HTTPContext)), Cells, HTML). 
+
+%-----------------------------------------------------------------------------%
+
+:- pred wrap_in_th_tags(table_col_class::in, string::in, string::out) is det.
+
+wrap_in_th_tags(Class, In, Out) :-
+    table_col_class_to_string(Class, ClassStr),
+    string.format("<th class\"%s\">%s</th>", [s(ClassStr), s(In)], Out).
+
+%-----------------------------------------------------------------------------%
+
+    % Determine how many rows the table header requires, and a map between
+    % column numbers and classes.  This should be used with foldl3 and
+    % takes a number of accumulator values.
+    %
+:- pred table_header_num_rows_and_classmap(table_header_cell::in,
+    table_header_rows::in, table_header_rows::out, 
+    int::in, int::out, col_class_map::in, col_class_map::out) is det.
+
+table_header_num_rows_and_classmap(Cell, !NumRows, !ColNum, !ClassMap) :-
+    (
+        Cell = table_header_cell(_, Class),
+        table_col_class_to_string(Class, ClassStr),
+        svmap.det_insert(!.ColNum, ClassStr, !ClassMap),
+        NumSubCols = 1
+    ;
+        Cell = table_header_group(_, Subtitles, Class),
+        length(Subtitles, NumSubCols),
+        !:NumRows = two,
+        table_col_class_to_string(Class, ClassStr),
+        % fold_up is inclusive of the higher number,
+        fold_up(insert_col_classmap(ClassStr), 
+            !.ColNum, !.ColNum + NumSubCols - 1, 
+            !ClassMap)
+    ),
+    !:ColNum = !.ColNum + NumSubCols.
+
+%-----------------------------------------------------------------------------%
+
+:- pred insert_col_classmap(string::in, int::in, 
+    col_class_map::in, col_class_map::out) is det.
+
+insert_col_classmap(Value, Key, !Map) :-
+    svmap.det_insert(Key, Value, !Map).
+
+%-----------------------------------------------------------------------------%
+
+    % Build a row of a HTML table from the table_row type.
+    %
+:- pred table_row_to_html(http_context::in, maybe(col_class_map)::in, int::in,
+    table_row::in, string::out) is det.
+
+table_row_to_html(HTTPContext, _, NumCols, table_section_header(Content), HTML) :-
+    table_data_to_string(HTTPContext, Content, Text),
+    string.format("<tr><td colspan=\"%d\">%s</td></tr>",
+        [i(NumCols), s(Text)], HTML).
+
+table_row_to_html(HTTPContext, ColClassMap, _, table_row(Cells), HTML) :-
+    map_join_html_count(table_cell_to_html(HTTPContext, ColClassMap), 0, Cells,
+        "", HTML0),
+    HTML = "<tr>" ++ HTML0 ++ "</tr>".
 
 %-----------------------------------------------------------------------------%
 
+:- pred table_cell_to_html(http_context::in, maybe(col_class_map)::in, int::in,
+    table_cell::in, string::out) is det.
+
+table_cell_to_html(_, _, _, table_empty_cell, "<td/>").
+
+table_cell_to_html(HTTPContext, MaybeClassMap, ColNum, table_cell(Data), HTML) :-
+    (
+        MaybeClassMap = yes(ClassMap),
+        ( map.search(ClassMap, ColNum, ClassPrime) ->
+            ClassStr = ClassPrime
+        ;
+            throw(software_error(string.format(
+                "Class map had no class for col %d, check table structure",
+                [i(ColNum)])))
+        )
+    ;
+        MaybeClassMap = no,
+        ( table_data_class(Data, ClassP) ->
+            Class = ClassP
+        ;
+            Class = default_table_col_class
+        ),
+        table_col_class_to_string(Class, ClassStr)
+    ),
+    table_data_to_string(HTTPContext, Data, Text),
+    string.format("<td class=\"%s\">%s</td>", [s(ClassStr), s(Text)], HTML). 
+
+%-----------------------------------------------------------------------------%
+
+:- pred table_data_to_string(http_context::in, table_data::in, string::out) 
+    is det.
+
+table_data_to_string(_, f(Float), two_decimal_fraction(Float)).
+table_data_to_string(_, i(Int), commas(Int)).
+table_data_to_string(HTTPCtxt, l(Link), HTML) :- 
+    link_to_html(HTTPCtxt, Link, HTML).
+table_data_to_string(_, m(Mem, Units, Decimals), format_memory(Mem, Units, Decimals)).
+table_data_to_string(_, p(Percent), format_percent(Percent)).
+table_data_to_string(_, s(String), escape_break_html_string(String)).
+table_data_to_string(_, t(Time), format_time(Time)).
+
+    % This predicate is used when a table class map couldn't be built from the
+    % header of the table (perhaps there was no header).  It it provides a
+    % class for some data that class is used, otherwise the default class is
+    % assumed.
+    %
+:- pred table_data_class(table_data::in, table_col_class::out) is semidet.
+
+table_data_class(f(_), table_col_class_number).
+table_data_class(i(_), table_col_class_number).
+table_data_class(m(_, _, _), table_col_class_number).
+table_data_class(p(_), table_col_class_number).
+table_data_class(t(_), table_col_class_number).
+
+:- func default_table_col_class = table_col_class.
+
+default_table_col_class = table_col_class_no_class.
+
+:- pred table_col_class_to_string(table_col_class::in, string::out) is det.
+
+table_col_class_to_string(table_col_class_allocations, "allocations").
+table_col_class_to_string(table_col_class_callseqs, "callseqs").
+table_col_class_to_string(table_col_class_memory, "memory").
+table_col_class_to_string(table_col_class_no_class, "default").
+table_col_class_to_string(table_col_class_number, "number").
+table_col_class_to_string(table_col_class_ordinal_rank, "ordinal_rank").
+table_col_class_to_string(table_col_class_port_counts, "port_counts").
+table_col_class_to_string(table_col_class_proc, "proc").
+table_col_class_to_string(table_col_class_ticks_and_times, "ticks_and_times").
+
+:- pred table_class_to_string(table_class::in, string::out) is det.
+
+table_class_to_string(table_class_menu, "menu").
+table_class_to_string(table_class_top_procs, "top_procs").
+
+%-----------------------------------------------------------------------------%
+% Link Related Predicates.
+%-----------------------------------------------------------------------------%
+
+:- pred link_class_to_string(link_class::in, string::out) is det.
+
+link_class_to_string(link_class_link, "default").
+link_class_to_string(link_class_control, "control").
+
+%-----------------------------------------------------------------------------%
+
+    % Information about the HTTP session.  This is used to create HTTP links as
+    % below.
+    %
+:- type http_context
+    --->    http_context(
+                server_name_port    :: string,
+                script_name         :: string,
+                deep_file           :: string
+            ).
+
+%-----------------------------------------------------------------------------%
+
+    % Transform a deep link into HTML.
+    %
+:- pred link_to_html(http_context::in, deep_link::in, string::out) is det.
+
+link_to_html(HTTPContext, deep_link(Cmd, MaybePrefs, Label, Class), HTML) :-
+    link_class_to_string(Class, ClassStr),
+    deep_cmd_to_url(HTTPContext, Cmd, MaybePrefs, URL),
+    (
+        Class = link_class_control,
+        FormatString = "<a class=""%s"" href=""%s"">[%s]</a>"
+    ;
+        Class = link_class_link,
+        FormatString = "<a class=""%s"" href=""%s"">%s</a>"
+    ),
+    string.format(FormatString, 
+        [ s(ClassStr), s(URL), s(escape_break_html_string(Label)) ], HTML).
+
+%-----------------------------------------------------------------------------%
+
+:- pred deep_to_http_context(deep::in, http_context::out) is det.
+
+deep_to_http_context(Deep, HTTPContext) :-
+    HTTPContext ^ server_name_port = Deep ^ server_name_port,
+    HTTPContext ^ script_name = Deep ^ script_name,
+    HTTPContext ^ deep_file = Deep ^ data_file_name.
+
+%-----------------------------------------------------------------------------%
+
+    % Return a URL for the deep structure and command.
+    %
+:- pred deep_cmd_to_url(http_context::in, cmd::in, maybe(preferences)::in,
+    string::out) is det.
+
+deep_cmd_to_url(HTTPContext, Cmd, MaybePrefs, URL) :-
+    HostAndPort = HTTPContext ^ server_name_port,
+    Script = HTTPContext ^ script_name,
+    DataFile = HTTPContext ^ deep_file,
+    CmdStr = cmd_to_string(Cmd),
+    (
+        MaybePrefs = no,
+        string.format("http://%s%s?%s&%s", 
+            [ s(HostAndPort), s(Script), s(CmdStr), s(DataFile) ], URL)
+    ;
+        MaybePrefs = yes(Prefs),
+        PrefStr = preferences_to_string(Prefs),
+        string.format("http://%s%s?%s&%s&%s", 
+            [s(HostAndPort), s(Script), s(CmdStr), s(PrefStr), s(DataFile)], 
+            URL)
+    ).
+
+%-----------------------------------------------------------------------------%
+% Generic html helper predicates.
+%-----------------------------------------------------------------------------%
+
+    % Compose a predicate from two distinct predicates.
+    %
+:- pred compose(pred(B, C), pred(A, B), A, C).
+:- mode compose(pred(in, out) is det, pred(in, out) is det, in, out) is det.
+
+compose(Q, P, X, Z) :- 
+    P(X, Y),
+    Q(Y, Z).
+
+%-----------------------------------------------------------------------------%
+
+    % Join two HTML snippits with the given delimiter.
+    %
+:- pred html_join(string::in, string::in, string::in, string::out) is det.
+
+html_join(Delim, H1, H2, H) :-
+    H = H1 ++ Delim ++ "\n" ++ H2.
+
+%-----------------------------------------------------------------------------%
+
+    % This predicate builds the concatentation of Acc and ASs where each AS
+    % is MapPred(A, AS), the Delim is placed between concatentated strings.
+    %
+:- pred map_join_html_acc(string, pred(A, string), list(A), string, string).
+:- mode map_join_html_acc(in, pred(in, out) is det, in, in, out) is det.
+
+map_join_html_acc(_, _, [], Result, Result).
+map_join_html_acc(Delim, MapPred, [ X | XS ], Acc0, Out) :-
+    MapPred(X, Y),
+    html_join(Delim, Acc0, Y, Acc),
+    map_join_html_acc(Delim, MapPred, XS, Acc, Out).
+
+    % For each A do MapPred(A, S) and return the concatenation of Ss
+    % seperated by Delim. 
+    %
+:- pred map_join_html(string, pred(A, string), list(A), string).
+:- mode map_join_html(in, pred(in, out) is det, in, out) is det.
+
+map_join_html(_, _, [], "").
+map_join_html(Delim, MapPred, [ X | XS ], Result) :-
+    MapPred(X, Str),
+    map_join_html_acc(Delim, MapPred, XS, Str, Result).
+
+    % For each A do MapPred(A, S) and concatenate all Ss.
+    %
+:- pred map_join_html(pred(A, string), list(A), string).
+:- mode map_join_html(pred(in, out) is det, in, out) is det.
+
+map_join_html(MapPred, List, Result) :-
+    map_join_html("", MapPred, List, Result).
+    
+    % This predicate is the same as above except that it passes an integer
+    % to the higher order call, the integer is incremented on each
+    % recursion.
+    %
+:- pred map_join_html_count(pred(int, A, string), int, list(A), string,
+    string).
+:- mode map_join_html_count(pred(in, in, out) is det, in, in, in, out) 
+    is det.
+
+map_join_html_count(_, _, [], Result, Result).
+map_join_html_count(MapPred, N, [ X | XS ], Acc0, Out) :-
+    MapPred(N, X, Y),
+    html_join("", Acc0, Y, Acc),
+    map_join_html_count(MapPred, N+1, XS, Acc, Out).
+
+%-----------------------------------------------------------------------------%
+
+    % Format a title for the given website.  It will be the common title,
+    % followed by an optional subtitle seperated by - 
+    %
+:- pred maybe_title_to_title(deep::in, maybe(string)::in, string::out) 
+    is det.  
+
+maybe_title_to_title(Deep, yes(Subtitle), Title) :-
+    maybe_title_to_title(Deep, no, MainTitle),
+    Title = MainTitle ++ " - " ++ Subtitle.
+
+maybe_title_to_title(Deep, no, Title) :-
+    Title = "Mercury Deep Profile for " ++ Deep ^ data_file_name.
+
+%-----------------------------------------------------------------------------%
+% Deprecated html_format code.
+%-----------------------------------------------------------------------------%
+
 page_banner(_Cmd, Pref) =
     "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01//EN""\n" ++
     """http://www.w3.org/TR/html4/strict.dtd"">\n" ++
@@ -1993,82 +2560,15 @@ format_time(Pref, Time) = TimeStr :-
 
 :- func one_decimal_fraction(float) = string.
 
-one_decimal_fraction(Measure) = Representation :-
-    string.format("%.1f", [f(Measure)], Str0),
-    string.to_char_list(Str0, Chars0),
-    list.reverse(Chars0, RevChars0),
-    (
-        RevChars0 = [Tenth, DecimalPoint | WholeRevChars0],
-        char.is_digit(Tenth)
-        % DecimalPoint = ('.')
-    ->
-        WholeRevChars = add_commas(WholeRevChars0),
-        RevChars = [Tenth, DecimalPoint | WholeRevChars],
-        Chars = list.reverse(RevChars),
-        string.from_char_list(Chars, Representation)
-    ;
-        error("one_decimal_fraction: malformed number")
-    ).
+one_decimal_fraction(Measure) = decimal_fraction("%.1f", Measure).
 
 :- func two_decimal_fraction(float) = string.
 
-two_decimal_fraction(Measure) = Representation :-
-    string.format("%.2f", [f(Measure)], Str0),
-    string.to_char_list(Str0, Chars0),
-    list.reverse(Chars0, RevChars0),
-    (
-        RevChars0 = [Hundredth, Tenth, DecimalPoint | WholeRevChars0],
-        char.is_digit(Hundredth),
-        char.is_digit(Tenth)
-        % DecimalPoint = ('.')
-    ->
-        WholeRevChars = add_commas(WholeRevChars0),
-        RevChars = [Hundredth, Tenth, DecimalPoint | WholeRevChars],
-        Chars = list.reverse(RevChars),
-        string.from_char_list(Chars, Representation)
-    ;
-        error("two_decimal_fraction: malformed number")
-    ).
+two_decimal_fraction(Measure) = decimal_fraction("%.2f", Measure).
 
 :- func four_decimal_fraction(float) = string.
 
-four_decimal_fraction(Measure) = Representation :-
-    string.format("%.4f", [f(Measure)], Str0),
-    string.to_char_list(Str0, Chars0),
-    list.reverse(Chars0, RevChars0),
-    (
-        RevChars0 = [TenThousandth, Thousandth, Hundredth, Tenth,
-            DecimalPoint | WholeRevChars0],
-        char.is_digit(TenThousandth),
-        char.is_digit(Thousandth),
-        char.is_digit(Hundredth),
-        char.is_digit(Tenth)
-        % DecimalPoint = ('.')
-    ->
-        WholeRevChars = add_commas(WholeRevChars0),
-        RevChars = [TenThousandth, Thousandth, Hundredth, Tenth,
-            DecimalPoint | WholeRevChars],
-        Chars = list.reverse(RevChars),
-        string.from_char_list(Chars, Representation)
-    ;
-        error("four_decimal_fraction: malformed number")
-    ).
-
-:- func commas(int) = string.
-
-commas(Num) = Str :-
-    string.format("%d", [i(Num)], Str0),
-    string.to_char_list(Str0, Chars0),
-    reverse(Chars0, RevChars0),
-    string.from_char_list(reverse(add_commas(RevChars0)), Str).
-
-:- func add_commas(list(char)) = list(char).
-
-add_commas([]) = [].
-add_commas([C]) = [C].
-add_commas([C, D]) = [C, D].
-add_commas([C, D, E]) = [C, D, E].
-add_commas([C, D, E, F | R]) = [C, D, E, (',') | add_commas([F | R])].
+four_decimal_fraction(Measure) = decimal_fraction("%.4f", Measure).
 
 :- func percentage(int, int) = string.
 
Index: deep_profiler/query.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/query.m,v
retrieving revision 1.20
diff -u -p -u -p -r1.20 query.m
--- deep_profiler/query.m	8 May 2008 10:59:59 -0000	1.20
+++ deep_profiler/query.m	9 Jul 2008 12:49:47 -0000
@@ -27,6 +27,7 @@
 :- module query.
 :- interface.
 
+:- import_module data_types.
 :- import_module profile.
 
 :- import_module bool.
@@ -163,10 +164,6 @@
     ;       memory(memory_units)
     ;       memory_and_percall(memory_units).
 
-:- type memory_units
-    --->    units_words
-    ;       units_bytes.
-
 :- type fields
     --->    fields(
                 port_fields     :: port_fields,
@@ -257,9 +254,12 @@
 
 :- implementation.
 
+:- import_module create_report.
+:- import_module display_report.
 :- import_module exclude.
 :- import_module html_format.
 :- import_module measurements.
+:- import_module report.
 :- import_module top_procs.
 :- import_module util.
 
@@ -300,18 +300,29 @@ try_exec(Cmd, Pref, Deep, HTML, !IO) :-
 :- pred exec(cmd::in, preferences::in, deep::in, string::out,
     io::di, io::uo) is det.
 
-exec(deep_cmd_restart, _Pref, _Deep, _HTML, !IO) :-
-    % Our caller is supposed to filter out restart commands.
-    error("exec: found restart command").
-exec(deep_cmd_quit, _Pref, Deep, HTML, !IO) :-
-    HTML = string.format(
-        "<H3>Shutting down deep profile server for %s.</H3>\n",
-        [s(Deep ^ data_file_name)]).
-exec(deep_cmd_timeout(TimeOut), _Pref, _Deep, HTML, !IO) :-
-    HTML = string.format("<H3>Timeout set to %d minutes</H3>\n", [i(TimeOut)]).
-exec(Cmd, Pref, Deep, HTML, !IO) :-
-    Cmd = deep_cmd_menu,
-    HTML = generate_menu_page(Cmd, Pref, Deep).
+exec(Cmd, Prefs, Deep, HTML, !IO) :-
+    ( Cmd = deep_cmd_quit
+    ; Cmd = deep_cmd_timeout(_)
+    ; Cmd = deep_cmd_restart
+    ; Cmd = deep_cmd_menu
+    ; Cmd = deep_cmd_top_procs(_, _, _, _)
+    ),
+    create_report(Cmd, Deep, Report),
+    display_report(Deep, Prefs, Report, Display),
+    htmlize_display(Deep, Display, HTML).
+
+% Old deep profiler cgi code.  This should remain supported until all the deep
+% profilier reports have been updated to use the new datastructures.
+%
+
+%exec(Cmd, Pref, Deep, HTML, !IO) :-
+%    Cmd = deep_cmd_menu,
+%    HTML = generate_menu_page(Cmd, Pref, Deep).
+%exec(Cmd, Pref, Deep, HTML, !IO) :-
+%    Cmd = deep_cmd_top_procs(Limit, CostKind, InclDesc, Scope),
+%    HTML = generate_top_procs_page(Cmd, Limit, CostKind, InclDesc, Scope,
+%        Pref, Deep).
+
 exec(Cmd, Pref, Deep, HTML, !IO) :-
     Cmd = deep_cmd_root(MaybePercent),
     deep_lookup_clique_index(Deep, Deep ^ root, RootCliquePtr),
@@ -370,10 +381,6 @@ exec(Cmd, Pref, Deep, HTML, !IO) :-
             "There is no procedure with that number.\n" ++
             page_footer(Cmd, Pref, Deep)
     ).
-exec(Cmd, Pref, Deep, HTML, !IO) :-
-    Cmd = deep_cmd_top_procs(Limit, CostKind, InclDesc, Scope),
-    HTML = generate_top_procs_page(Cmd, Limit, CostKind, InclDesc, Scope,
-        Pref, Deep).
 exec(deep_cmd_proc_static(PSI), _Pref, Deep, HTML, !IO) :-
     HTML = generate_proc_static_debug_page(PSI, Deep).
 exec(deep_cmd_proc_dynamic(PDI), _Pref, Deep, HTML, !IO) :-

report.m:
%-----------------------------------------------------------------------------%
% 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: report.m.
% Author: pbone.
%
% This module contains a data structure for deep profiling reports.
%
%-----------------------------------------------------------------------------%

:- module report.
:- interface.

:- import_module list.
:- import_module string.

:- import_module data_types.
:- import_module profile.
% XXX: Data structures should be in some other file,
:- import_module query.

%-----------------------------------------------------------------------------%

:- type deep_report
    --->    report_message(string)
    ;       report_menu(
                quanta_per_sec  :: int,
                user_quanta     :: int,
                inst_quanta     :: int,
                num_callsequs   :: int,
                num_csd         :: int,
                num_css         :: int,
                num_pd          :: int,
                num_ps          :: int,
                num_clique      :: int
            )
    ;       report_top_procs(
                ordering        :: report_ordering,
                top_procs       :: list(row_data(report_proc))
            ).


:- type row_data(T)
    --->    row_data(
                % The item represented by this data row.
                subject             :: T,

                % Port counts
                calls               :: int,
                exits               :: int,
                fails               :: int,
                redos               :: int,
                excps               :: int,

                % Clock ticks and times, Ticks are 'countable' so int is
                % used.  Time is discrete and has units so a time type is
                % used.  When percent is NaN because the total time for the
                % program is close to zero the percent type will represent
                % 'not_applicable' or 'do not know'.
                self_ticks          :: int,
                self_time           :: time,
                self_time_percent   :: percent,
                self_time_percall   :: time,
                
                ticks               :: int,
                time                :: time,
                time_percent        :: percent,
                time_percall        :: time,
                
                % Call sequence counts,
                self_callseqs           :: int,
                self_callseqs_percent   :: percent,
                self_callseqs_percall   :: float,

                callseqs                :: int,
                callseqs_percent        :: percent,
                callseqs_percall        :: float,

                % Memory allocations,
                self_allocs         :: int,
                self_allocs_percent :: percent,
                self_allocs_percall :: float,

                allocs              :: int,
                allocs_percent      :: percent,
                allocs_percall      :: float,

                % Memory used.  Since memory has a scale it's stored in a
                % memory type.  Memory per call might not be an integer,
                % perhaps a new type should be used here.
                bytes_per_word      :: int,
                self_mem            :: memory,
                self_mem_percent    :: percent,
                self_mem_percall    :: memory,

                mem                 :: memory,
                mem_percent         :: percent,
                mem_percall         :: memory
            ).


:- type report_ordering
    --->    report_ordering(
                display_limit   :: display_limit,
                cost_kind       :: cost_kind,
                incl_desc       :: include_descendants,
                scope           :: measurement_scope
            ).


    % A procedure and associated information for use in reports.
    %
:- type report_proc
    --->    report_proc(
                proc_static_ptr     :: proc_static_ptr,
                proc_filename       :: string,
                proc_linenumber     :: int,
                proc_name           :: string
            ).

%-----------------------------------------------------------------------------%
:- end_module report.
%-----------------------------------------------------------------------------%

display.m:
%-----------------------------------------------------------------------------%
% 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: display.m.
% Author: pbone.
%
% This module contains a data structure for displaying deep profiler
% reports.  It may be versatile enough for other uses.
%
%-----------------------------------------------------------------------------%

:- module display.
:- interface.

:- import_module list.
:- import_module maybe.
:- import_module string.

:- import_module data_types.
:- import_module query.

%-----------------------------------------------------------------------------%

:- type display
    --->    display(
                title       :: maybe(string),
                content     :: list(display_item)
            ).

:- type display_item
    --->    display_message(string)
    ;       display_table(table)
    ;       display_list(
                list_class,
                    % Class of the list, may be used to display the list.

                maybe(string),
                    % An optional title.
 
                list(display_item)
                    % Items within the list.
            )
    ;       display_command_link(deep_link).

%-----------------------------------------------------------------------------%
% Table specific structures.
%-----------------------------------------------------------------------------%

:- type table
    --->    table(
                table_class     :: table_class,
                    % Enumeration of what the table stores, this can be used
                    % for layout hints.
    
                table_num_cols  :: int,
                    % The number of coloums in the table.  This is specified
                    % here to make it clear when the table is not
                    % well-formed.

                table_header    :: maybe(table_header),
                    % Header row of table.
                
                table_rows      :: list(table_row)
                    % Data in table,
            ).

:- type table_header
    --->    table_header(
                th_cells        :: list(table_header_cell)            
            ). 

:- type table_header_cell
    --->    table_header_cell(
                thc_contents    :: table_data,
                    % The table contents.

                thc_class       :: table_col_class
                    % The class may be used by a layout to make decisions
                    % about how to paint this column.
            )
    ;       table_header_group(
                thg_title       :: string,
                thg_subtitles   :: list(table_data),
                
                thg_class       :: table_col_class
                    % The class may be used by a layout to make decisions
                    % about how to paint this column.
            ).

:- type table_row
    --->    table_row(
                tr_cells    :: list(table_cell)
            )
    ;       table_section_header(
                tsh_text    :: table_data
            ).

:- type table_cell
    --->    table_cell(
                tc_text     :: table_data
            )
    ;       table_empty_cell.

:- type table_class
    --->    table_class_menu
    ;       table_class_top_procs.

:- type table_col_class
    --->    table_col_class_allocations
    ;       table_col_class_callseqs
    ;       table_col_class_memory
    ;       table_col_class_no_class
    ;       table_col_class_number
    ;       table_col_class_ordinal_rank
    ;       table_col_class_port_counts
    ;       table_col_class_proc
    ;       table_col_class_ticks_and_times.

    % Table data can be specified by type to allow formatting, for example
    % to align decimal points.
    %
:- type table_data
    --->    f(float)
    ;       i(int)
    ;       l(deep_link)
    ;       m(
                memory,
                    % The amount of memory
                    
                memory_units,
                    % The units to display memory in

                int
                    % The number of decimal places to show
            )
    ;       p(percent)
    ;       s(string)
    ;       t(time).

%-----------------------------------------------------------------------------%
% List specific structures
%-----------------------------------------------------------------------------%

:- type list_class
    --->    list_class_vertical_no_bullets
    ;       list_class_vertical_bullets
    ;       list_class_horizontal.

%-----------------------------------------------------------------------------%
% Link specific structures
%-----------------------------------------------------------------------------%

:- type deep_link
    --->    deep_link(
                cmd,
                    % The link command.
               
                maybe(preferences),
                    % The preferences for the link command.

                string,
                    % A label for the link.
                
                link_class
                    % Class of the link may control how it is displayed.
            ).

:- type link_class
    --->    link_class_link
    ;       link_class_control.

%-----------------------------------------------------------------------------%
% Predicates for working with display structures.
%-----------------------------------------------------------------------------%

    % If given a header this predicate adds it to the head of the list and adds
    % the correct number of columns to the column count.
    %
:- pred table_maybe_add_header_col(maybe(table_header_cell)::in,
    list(table_header_cell)::in, list(table_header_cell)::out, 
    int::in, int::out) is det.

    % Given a header this predicate adds it to the head of the list and adds
    % the correct number of columns to the column count.
    %
:- pred table_add_header_col(table_header_cell::in,
    list(table_header_cell)::in, list(table_header_cell)::out, 
    int::in, int::out) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module int.


table_maybe_add_header_col(no, !Cols, !NumCols).

table_maybe_add_header_col(yes(HeaderCol), !Cols, !NumCols) :-
    table_add_header_col(HeaderCol, !Cols, !NumCols).

table_add_header_col(Cell, !Cols, !NumCols) :-
    (
        Cell = table_header_cell(_, _),
        ColsAddend = 1
    ;
        Cell = table_header_group(_, SubHeaders, _),
        length(SubHeaders, ColsAddend)
    ),
    !:NumCols = !.NumCols + ColsAddend,
    list.cons(Cell, !Cols).

%-----------------------------------------------------------------------------%
:- end_module display.
%-----------------------------------------------------------------------------%

data_types.m:
%-----------------------------------------------------------------------------%
% 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: data_types.m.
% Author: pbone.
%
% This module contains a memory, time and percentage abstract data types and
% predicates and functions for using them.
%
%-----------------------------------------------------------------------------%

:- module data_types.

:- interface.

:- import_module int.
:- import_module string.

%-----------------------------------------------------------------------------%
% Memory
%-----------------------------------------------------------------------------%

    % Units avalible for measuring memory in.
    %
:- type memory_units
    --->    units_words
    ;       units_bytes.

%-----------------------------------------------------------------------------%

    % Memory ADT.
    %
:- type memory.

%-----------------------------------------------------------------------------%

    % memory_words(Memory, Words, BytesPerWord)
    % 
    % Convert between words and 'memory' unit.
    %
:- pred memory_words(memory, int, int).
:- mode memory_words(out, in, in) is det.

%-----------------------------------------------------------------------------%

    % Division for memory units.  Use of this function may return continous
    % units.
:- func (memory) / (int) = (memory) is det.

%-----------------------------------------------------------------------------%

    % Format a memory value using the given units.
    %
    % The third argument is the number of decimal places to show.
    %
:- func format_memory(memory, memory_units, int) = string.

%-----------------------------------------------------------------------------%
% Percent
%-----------------------------------------------------------------------------%
    
    % Percent abstract data type.
    % 
:- type percent.

%-----------------------------------------------------------------------------%

    % Convert between percent value and a float between 0.0 and 1.0
    % (inclusive), input of values outside this range will throw exceptions.
    %
:- pred percent(percent::out, float::in) is det.

%-----------------------------------------------------------------------------%

    % Format a percentage.  Prints the percentage with one decimal place and a
    % '%' symbol.
    %
:- func format_percent(percent) = string.

%-----------------------------------------------------------------------------%
% Time
%-----------------------------------------------------------------------------%
    
    % Time abstract data type.
    % 
:- type time.

%-----------------------------------------------------------------------------%

    % ticks_to_time(Ticks, TicksPerSec, Time)
    %
    % Converts profilier ticks to time,
    %
:- pred ticks_to_time(int::in, int::in, time::out) is det.

%-----------------------------------------------------------------------------%

    % time_percall(Time, Calls, TimePercall)
    %
    % Time / Calls = TimePerCall.
    %
:- pred time_percall(time::in, int::in, time::out) is det.

%-----------------------------------------------------------------------------%

    % Format a time, this prints the time in the most readable units for it's
    % magnitude.  one or two letters follow the time to describe the units.
    %
    % Currently supported units are seconds; milli, micro, nano and pico
    % seconds.  For micro seconds a letter u is used rather than the greek
    % letter mu.
    %
:- func format_time(time) = string.

%-----------------------------------------------------------------------------%
% Code for formatting numbers.
%-----------------------------------------------------------------------------%

    % Format an integer and place commas between groups of three digits.
    %
:- func commas(int) = string.

    % Format a floating point number, placing commas between groups of three
    % digits in the integer part.
    %
:- func decimal_fraction(string, float) = string.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module char.
:- import_module exception.
:- import_module float.
:- import_module list.
:- import_module math.
:- import_module require.

%-----------------------------------------------------------------------------%
% Memory
%-----------------------------------------------------------------------------%

:- type memory
    --->    memory_words(
                words       :: float,
                word_size   :: int
            ).

%-----------------------------------------------------------------------------%

memory_words(memory_words(WordsF, BytesPerWord), WordsI, BytesPerWord) :-
    WordsF = float(WordsI).

%-----------------------------------------------------------------------------%

    % Divison operator.
memory_words(Nom, BPW) / Denom = 
memory_words(Nom / float(Denom), BPW).

%-----------------------------------------------------------------------------%

format_memory(memory_words(Words, BPW), units_bytes, Decimals) =  
    format_number(Decimals, Words * float(BPW)).
format_memory(memory_words(Words, _), units_words, Decimals) = 
    format_number(Decimals, Words).

%-----------------------------------------------------------------------------%
% Percent
%-----------------------------------------------------------------------------%

:- type percent
    --->    percent(float).

%-----------------------------------------------------------------------------%

percent(percent(P), P) :-
    ( (P >= 0.0, P =< 1.0) ->
        true
    ; 
        throw(software_error(
            "Percentage value out of range 0.0 to 1.0 (inclusive)"))
    ).

%-----------------------------------------------------------------------------%

format_percent(percent(P)) = String :-
    string.format("%.2f", [f(P*100.0)], String).

%-----------------------------------------------------------------------------%
% Time. 
%-----------------------------------------------------------------------------%

    % Time is stored in seconds using a float.
    %
:- type time
    --->    time_sec(float).

%-----------------------------------------------------------------------------%

ticks_to_time(Ticks, TicksPerSec, Time) :-
    SecPerTick = 1.0/float(TicksPerSec),
    Time = time_sec(float(Ticks) * SecPerTick).

%-----------------------------------------------------------------------------%

time_percall(time_sec(Time), Calls, time_sec(Time/float(Calls))).

%-----------------------------------------------------------------------------%

:- func milli = float.
milli = 0.001.

:- func micro = float.
micro = 0.000001.

:- func nano = float.
nano = 0.000000001.

:- func pico = float.
pico = 0.000000000001.

%
% Fix: When there is no resolution beyond 10ms since there is a clock tick
% every 10ms, the decimal points on some of these numbers should not be shown.
% However it's probably useful to show at least 2 decimal points when the value
% is within the range 1-10 seconds.
%
format_time(time_sec(F)) = String :-
    ( F < nano ->
        % Print in ps.
        string.format("%.1fps", [f(F / pico)], String)
    ; F < micro ->
        % Print in ns.
        string.format("%.1fns", [f(F / nano)], String)
    ; F < milli ->
        % Print in us.
        string.format("%.1fus", [f(F / micro)], String)
    ; F < 1.0 ->
        % Print in ms.
        string.format("%.1fms", [f(F / milli)], String)
    ;
        % Print in seconds.
        string.format("%.1fs", [f(F)], String)
    ).

%-----------------------------------------------------------------------------%
% Code for formatting numbers.
%-----------------------------------------------------------------------------%

commas(Num) = Str :-
    string.format("%d", [i(Num)], Str0),
    add_commas_intstr(Str0, Str).

%-----------------------------------------------------------------------------%

decimal_fraction(Format, Measure) = Representation :-
    string.format(Format, [f(Measure)], Str0),
    string.split_at_char('.', Str0) = SubStrings,
    (
        SubStrings = [WholeString0, FractionString]
    ->
        add_commas_intstr(WholeString0, WholeString),
        Representation = WholeString ++ "." ++ FractionString
    ;
        % If there are no decimal symbols in the number, try to work with it as
        % an integer.
        SubStrings = [WholeString]
    ->
        add_commas_intstr(WholeString, Representation)
    ;    
        error("decimal_fraction: Didn't split on decimal point properly")
    ).

%-----------------------------------------------------------------------------%

:- pred add_commas_intstr(string::in, string::out) is det.

add_commas_intstr(Str0, Str) :-
    string.to_char_list(Str0, Chars0),
    reverse(Chars0, RevChars0),
    string.from_char_list(reverse(add_commas(RevChars0)), Str).

:- func add_commas(list(char)) = list(char).

add_commas([]) = [].
add_commas([C]) = [C].
add_commas([C, D]) = [C, D].
add_commas([C, D, E]) = [C, D, E].
add_commas([C, D, E, F | R]) = [C, D, E, (',') | add_commas([F | R])].

%-----------------------------------------------------------------------------%

:- func format_number(int, float) = string.

format_number(Decimals, Num) = String :-
    Format = "%." ++ string(Decimals) ++ "f",
    decimal_fraction(Format, Num) = String.

%-----------------------------------------------------------------------------%
:- end_module data_types.
%-----------------------------------------------------------------------------%

create_report.m:
%-----------------------------------------------------------------------------%
% 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: create_report.m.
% Author: pbone.
%
% This module contains the create_report predicate that creates a report
% from a deep data structure and a query.
%
%-----------------------------------------------------------------------------%

:- module create_report.
:- interface.

:- import_module report.
:- import_module profile.
:- import_module query.

%-----------------------------------------------------------------------------%

:- pred create_report(cmd::in, deep::in, deep_report::out) is det.

%-----------------------------------------------------------------------------%

:- implementation.

:- import_module data_types.
:- import_module measurements.
:- import_module top_procs.

:- import_module array.
:- import_module exception.
:- import_module float.
:- import_module int.
:- import_module list.
:- import_module maybe.
:- import_module string.

%-----------------------------------------------------------------------------%

create_report(deep_cmd_quit, Deep, Report) :-
    Report = report_message(string.format(
        "Shutting down deep profile server for %s.",
        [s(Deep ^ data_file_name)])).

create_report(deep_cmd_timeout(Timeout), _Deep, Report) :-
    Report = report_message(string.format(
        "Timeout set to %d minutes.", [i(Timeout)])).

create_report(deep_cmd_restart, _, _) :-
    error("create_report/3", "unexpected restart command").

create_report(deep_cmd_menu, Deep, Report) :-
    Deep ^ profile_stats = profile_stats(NumCSD, NumCSS, NumPD, NumPS,
        QuantaPerSec, InstrumentationQuanta, UserQuanta, NumCallsequs, _, _),
    NumClique = array.max(Deep ^ clique_members),
    Report = report_menu(QuantaPerSec, UserQuanta, InstrumentationQuanta,
        NumCallsequs, NumCSD, NumCSS, NumPD, NumPS, NumClique).

create_report(deep_cmd_top_procs(Limit, CostKind, InclDesc, Scope), Deep, Report) :-
    create_top_procs_report(Deep, Limit, CostKind, InclDesc, Scope, Report).

create_report(Cmd, _, _) :-
    ( Cmd = deep_cmd_root(_)
    ; Cmd = deep_cmd_clique(_)
    ; Cmd = deep_cmd_proc(_)
    ; Cmd = deep_cmd_proc_callers(_, _, _)
    ; Cmd = deep_cmd_modules
    ; Cmd = deep_cmd_module(_)
    ; Cmd = deep_cmd_proc_static(_)
    ; Cmd = deep_cmd_proc_dynamic(_)
    ; Cmd = deep_cmd_call_site_static(_)
    ; Cmd = deep_cmd_call_site_dynamic(_)
    ; Cmd = deep_cmd_raw_clique(_)),
    error("create_report/3", "Command not supported: " ++ string(Cmd)).

%-----------------------------------------------------------------------------%
% Code to build top_procs report.
%-----------------------------------------------------------------------------%

    % Create a top procs report, from the given data with the specified
    % parameters.
    %
:- pred create_top_procs_report(deep::in, display_limit::in, cost_kind::in,
    include_descendants::in, measurement_scope::in, deep_report::out) is det.

create_top_procs_report(Deep, Limit, CostKind, InclDesc0, Scope0, Report) :-
    (
        CostKind = cost_calls,
        % Counting calls is incompatible both with self_and_desc
        % and per_call.
        InclDesc = self,
        Scope = overall
    ;
        ( CostKind = cost_redos
        ; CostKind = cost_time
        ; CostKind = cost_callseqs
        ; CostKind = cost_allocs
        ; CostKind = cost_words
        ),
        InclDesc = InclDesc0,
        Scope = Scope0
    ),
    MaybeTopPSIs = find_top_procs(CostKind, InclDesc, Scope, Limit, Deep),
    (
        MaybeTopPSIs = error(ErrorMessage),
        Report = report_message("Internal error: " ++ ErrorMessage)
    ;
        MaybeTopPSIs = ok(TopPSIs),
        Ordering = report_ordering(Limit, CostKind, InclDesc, Scope),
        map(psi_to_row_data(Deep), TopPSIs, RowData),
        Report = report_top_procs(Ordering, RowData)
    ).

%-----------------------------------------------------------------------------%

    % For a Proc Static Index query the deep data and retrive the data to
    % include in that row of the report.
    %
:- pred psi_to_row_data(deep::in, int::in, row_data(report_proc)::out) is det.

psi_to_row_data(Deep, PSI, RowData) :-
    % Gather global deep profiling information.
    ProfileStats = Deep ^ profile_stats,
    TicksPerSec = ProfileStats ^ ticks_per_sec,
    WordSize = ProfileStats ^ word_size,
    Root = root_total_info(Deep),

    PSPtr = wrap_proc_static_ptr(PSI),  

    % Retrive data.
    deep_lookup_ps_own(Deep, PSPtr, Own),
    deep_lookup_ps_desc(Deep, PSPtr, Desc),

    % Set Subject.
    psptr_to_report_proc(Deep, PSPtr, ReportProc),
    RowData ^ subject = ReportProc,

    % Set port counts.
    Calls = calls(Own), % This variable is re-used
    RowData ^ calls = Calls,
    RowData ^ exits = exits(Own),
    RowData ^ fails = fails(Own),
    RowData ^ redos = redos(Own),
    RowData ^ excps = excps(Own),

    % Set self times.
    TotalQuanta = inherit_quanta(Root),
    SelfTicks = quanta(Own),
    ticks_to_time(SelfTicks, TicksPerSec, SelfTime),
    time_percall(SelfTime, Calls, SelfTimePercall),
    SelfTimePercent = percent_from_ints(SelfTicks, TotalQuanta),
    RowData ^ self_ticks = quanta(Own),
    RowData ^ self_time = SelfTime,
    RowData ^ self_time_percent = SelfTimePercent,
    RowData ^ self_time_percall = SelfTimePercall,
   
    % Set times for self + descendants.
    Ticks = SelfTicks + inherit_quanta(Desc), 
    ticks_to_time(Ticks, TicksPerSec, Time),
    time_percall(Time, Calls, TimePercall),
    TimePercent = percent_from_ints(Ticks, TotalQuanta),
    RowData ^ ticks = Ticks,
    RowData ^ time = Time,
    RowData ^ time_percent = TimePercent,
    RowData ^ time_percall = TimePercall,

    % Call sequence counts.
    TotalCallseqs = inherit_callseqs(Root),
    SelfCallseqs = callseqs(Own),
    RowData ^ self_callseqs = SelfCallseqs,
    RowData ^ self_callseqs_percent = 
        percent_from_ints(SelfCallseqs, TotalCallseqs),
    RowData ^ self_callseqs_percall = divide_ints(SelfCallseqs, Calls),

    Callseqs = callseqs(Own) + inherit_callseqs(Desc),
    RowData ^ callseqs = Callseqs,
    RowData ^ callseqs_percent = percent_from_ints(Callseqs, TotalCallseqs),
    RowData ^ callseqs_percall = divide_ints(Callseqs, Calls),

    % Set memory allocations.
    TotalAllocs = inherit_allocs(Root),
    SelfAllocs = allocs(Own),
    Allocs = SelfAllocs + inherit_allocs(Desc),
    RowData ^ self_allocs = SelfAllocs,
    RowData ^ self_allocs_percent = percent_from_ints(SelfAllocs, TotalAllocs),
    RowData ^ self_allocs_percall = divide_ints(SelfAllocs, Calls),
    RowData ^ allocs = Allocs,
    RowData ^ allocs_percent = percent_from_ints(Allocs, TotalAllocs),
    RowData ^ allocs_percall = divide_ints(Allocs, Calls),
    
    % set memory information.
    TotalWords = inherit_words(Root),
    SelfWords = words(Own),
    memory_words(SelfMemory, SelfWords, WordSize),
    RowData ^ bytes_per_word = WordSize,
    RowData ^ self_mem = SelfMemory,
    RowData ^ self_mem_percent = percent_from_ints(SelfWords, TotalWords),
    RowData ^ self_mem_percall = SelfMemory / Calls,
    Words = SelfWords + inherit_words(Desc),
    memory_words(Memory, Words, WordSize),
    RowData ^ mem = Memory,
    RowData ^ mem_percent = percent_from_ints(Words, TotalWords),
    RowData ^ mem_percall = Memory / Calls.

%-----------------------------------------------------------------------------%

    % divide_ints(Nom, Demon) is the quotent of Nom and Denom, after they've
    % both been cast to float.
    %
:- func divide_ints(int, int) = float.

divide_ints(Nom, Denom) = Quotent :-
    Quotent = float(Nom) / float(Denom).

%-----------------------------------------------------------------------------%

    % Give the percentage of two 'counts'.
    %
:- func percent_from_ints(int, int) = percent.

percent_from_ints(Nom, Denom) = Percent :-
    percent(Percent, divide_ints(Nom, Denom)).

%-----------------------------------------------------------------------------%

    % Create a report_proc structure for a given proc static pointer.
    %
:- pred psptr_to_report_proc(deep::in, proc_static_ptr::in, report_proc::out)
    is det.

psptr_to_report_proc(Deep, PSPtr, report_proc(PSPtr, Filename, Lineno, Name))
        :-
    proc_static_get_proc_info(Deep, PSPtr, Filename, Lineno, Name).

%-----------------------------------------------------------------------------%

    % Get appropriate source location information for a proc static pointer.
    %
:- pred proc_static_get_proc_info(deep::in, proc_static_ptr::in, string::out,
    int::out, string::out) is det. 

proc_static_get_proc_info(Deep, PSPtr, FileName, LineNumber, Name) :-
    ( valid_proc_static_ptr(Deep, PSPtr) ->
        deep_lookup_proc_statics(Deep, PSPtr, PS),
        FileName = PS ^ ps_file_name,
        LineNumber = PS ^ ps_line_number,
        Name = PS ^ ps_refined_id
    ;
        FileName = "",
        LineNumber = 0,
        Name = "mercury_runtime"
    ).

%-----------------------------------------------------------------------------%
% Code shared across entire module.
%-----------------------------------------------------------------------------%

:- func this_file = string.

this_file = "create_report.m".

%-----------------------------------------------------------------------------%

:- func error_message(string, string) = string.

error_message(Pred, Message) = Error :-
    Error = this_file ++ ": " ++ Pred ++ ": " ++ Message.

%-----------------------------------------------------------------------------%

:- pred error(string::in, string::in) is erroneous.

error(Pred, Message) :-
    throw(software_error(error_message(Pred, Message))).

%-----------------------------------------------------------------------------%
:- end_module create_report.
%-----------------------------------------------------------------------------%

display_report.m
%-----------------------------------------------------------------------------%
% 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: display_report.m.
% Author: pbone.
%
% This module contains code to create a display data structure from a deep
% profiling report.
%
%-----------------------------------------------------------------------------%

:- module display_report.
:- interface.

:- import_module display.
:- import_module profile.
:- import_module report.

% XXX: This include should be removed or replaced.  Some datastructes such as
% preferences are currenty defined in query, the should be moved into a
% different module so that this module doesn't need to include the whole of
% query.
:- import_module query.

%-----------------------------------------------------------------------------%

:- pred display_report(deep::in, preferences::in, deep_report::in, display::out)
    is det.
    
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module data_types.

:- import_module bool.
:- import_module float.
:- import_module int.
:- import_module list.
:- import_module maybe.
:- import_module pair.
:- import_module string.

%-----------------------------------------------------------------------------%

display_report(_, _, report_message(Msg), Display) :-
    Display = display(no, [display_message(Msg)]).

display_report(Deep, _, Report, Display) :-
    Report = report_menu(QuantaPerSec, UserQuanta, InstQuanta, NumCallsequs,
        NumCSD, NumCSS, NumPD, NumPS, NumClique),
    display_report_menu(Deep, QuantaPerSec, UserQuanta, InstQuanta,
        NumCallsequs, NumCSD, NumCSS, NumPD, NumPS, NumClique, Display).

display_report(_, Prefs, report_top_procs(Ordering, TopProcs), Display) :-
    display_report_top_procs(Prefs, Ordering, TopProcs, Display).

%-----------------------------------------------------------------------------%
% Code to display menu report..
%-----------------------------------------------------------------------------%

:- pred display_report_menu(deep::in, int::in, int::in, int::in, int::in,
    int::in, int::in, int::in, int::in, int::in, display::out)
    is det.

display_report_menu(Deep, QuantaPerSec, UserQuanta, InstQuanta, NumCallsequs,
        NumCSD, NumCSS, NumPD, NumPS, NumClique, Display) :-
    ShouldDisplayTimes = should_display_times(Deep),
    
    % Display the links section of the report.
    LinksDataPart0 = 
        [(deep_cmd_root(no) - 
            "Exploring the call graph, starting at the root."),
         (deep_cmd_root(yes(90)) - 
            "Exploring the call graph, starting at the action."),
         (deep_cmd_modules -
            "Exploring the program module by module.")],
    LinksDataPart2 =  
        [(deep_cmd_top_procs(rank_range(1, 100), cost_callseqs, self,
                overall) -
            "Top 100 most expensive procedures: callseqs, self."),
         (deep_cmd_top_procs(rank_range(1, 100), cost_callseqs, self_and_desc,
                overall) -
            "Top 100 most expensive procedures: callseqs, self+descendants."),
         (deep_cmd_top_procs(rank_range(1, 100), cost_words, self, overall) -
            "Top 100 most expensive procedures: words, self."),
         (deep_cmd_top_procs(rank_range(1, 100), cost_words, self_and_desc,
                overall) -
            "Top 100 most expensive procedures: words, self+descendants.")],
    LinksDataPart4 = 
        [(deep_cmd_top_procs(threshold_percent(0.1), cost_callseqs, self, 
                overall) -
            "Procedures above 0.1% threshold: callseqs, self."),
         (deep_cmd_top_procs(threshold_percent(1.0), cost_callseqs, 
                self_and_desc, overall) - 
            "Procedures above 1% threshold: callseqs, self+descendants."),
         (deep_cmd_top_procs(threshold_value(1000000.0), cost_callseqs, 
                self_and_desc, overall) -
            ("Procedures above 1,000,000 callseqs threshold: callseqs, " ++
                "self+descendants.")),
         (deep_cmd_top_procs(threshold_percent(0.1), cost_words, self, 
                overall) -
            "Procedures above 0.1% threshold: words, self."),
         % 2M words is chosen arbitrary because it is 8MB on ia32
         (deep_cmd_top_procs(threshold_percent(1.0), cost_words, 
                self_and_desc, overall) -
            "Procedures above 1% threshold: words, self+descendants."),
         (deep_cmd_top_procs(threshold_value(float(1024 * 1024 * 2)), 
                cost_words, self_and_desc, overall) -
            "Procedures above 2M words threshold: words, self+descendants.")],
    (
        ShouldDisplayTimes = yes,
        LinksDataPart1 =
            [(deep_cmd_top_procs(rank_range(1, 100), cost_time, self, overall) -
                "Top 100 most expensive procedures: time, self."),
             (deep_cmd_top_procs(rank_range(1, 100), cost_time, self_and_desc,
                    overall) -
                "Top 100 most expensive procedures: time, self+descendants.")],
        LinksDataPart3 = 
            [(deep_cmd_top_procs(threshold_percent(0.1), cost_time, self,
                    overall) -
                "Procedures above 0.1% threshold: time, self."),
             (deep_cmd_top_procs(threshold_percent(1.0), cost_time,
                    self_and_desc, overall) -
                "Procedures above 1% threshold: time, self+descendants."),
             (deep_cmd_top_procs(threshold_value(100.0), cost_time,
                    self_and_desc, overall) -
                "Procedures above 1 second threshold: time, self+descendants.")]
    ;
        ShouldDisplayTimes = no,
        LinksDataPart1 = [],
        LinksDataPart3 = []
    ),
    LinksData = LinksDataPart0 ++ LinksDataPart1 ++ LinksDataPart2 ++ 
        LinksDataPart3 ++ LinksDataPart4,
    map(make_command_link, LinksData, LinksList),
    Links = display_list(list_class_vertical_bullets, 
        yes("You can start exploring the deep profile at the following" ++ 
            " points."), LinksList),

    % Display the table section of the report.
    Data = [("Quanta per second:"           - QuantaPerSec),
            ("Quanta in user code:"         - UserQuanta),
            ("Quanta in instrumentation:"   - InstQuanta),
            ("Call sequence numbers:"       - NumCallsequs),
            ("CallSiteDyanic structures:"   - NumCSD),
            ("ProcDynamic structures:"      - NumPD),
            ("CallSiteStatic structures:"   - NumCSS),
            ("ProcStatic structures:"       - NumPS),
            ("Cliques:"                     - NumClique)],
    map(make_menu_table_row, Data, Rows),
    Table = table(table_class_menu, 2, no, Rows),

    % Display the Controls section of the report.
    Controls = display_list(list_class_horizontal, no, cmds_menu_restart_quit),

    % Construct the complete representation of what to display.
    Display = display(yes("Deep profiler menu"), 
        [Links, display_table(Table), Controls]).

%-----------------------------------------------------------------------------%

    % Make a table row as used in the menu report.
    %
:- pred make_menu_table_row(pair(string, int)::in, table_row::out) is det.

make_menu_table_row((Label - Value), Row) :-
    Row = table_row([table_cell(s(Label)), table_cell(i(Value))]).

%-----------------------------------------------------------------------------%

    % Make a link for use in the menu report.
    %
:- pred make_command_link(pair(cmd, string)::in, display_item::out) is det.

make_command_link((Cmd - Label), Item) :-
    Item = display_command_link(deep_link(Cmd, no, Label, link_class_link)).

%-----------------------------------------------------------------------------%
% Code to display a top procedures report.
%-----------------------------------------------------------------------------%

    % Create a display_report structure for a top_procedures report.
    %
:- pred display_report_top_procs(preferences::in, report_ordering::in,
    list(row_data(report_proc))::in, display::out) is det.

display_report_top_procs(Prefs, Ordering, TopProcs, Display) :-
    Ordering = report_ordering(DisplayLimit, CostKind, InclDesc, Scope), 
    Desc = cost_criteria_to_description(CostKind, InclDesc, Scope),
    Title = "Top procedures " ++ Desc, 

    %
    % Build table
    %
    top_procs_table(Prefs, Ordering, TopProcs, Table),
    DisplayTable = display_table(Table), 
    TableAndLabel = display_list(list_class_vertical_no_bullets,
        yes(Title), [DisplayTable]),

    %
    % Build controls at bottom of page
    %
    Cmd = deep_cmd_top_procs(DisplayLimit, CostKind, InclDesc, Scope),
    sort_controls(Prefs, Ordering, SortControls),
    incldesc_and_scope_controls(Prefs, Ordering, InclDescScope),
    Controls1 = display_list(list_class_vertical_no_bullets, no,
        [SortControls, InclDescScope]),
    
    field_controls(Prefs, Cmd, Controls2),
    
    display_controls(Prefs, Cmd, Controls3),

    Controls4 =  
        display_list(list_class_horizontal, no, cmds_menu_restart_quit),

    Display = display(yes(Title), 
        [TableAndLabel, Controls1, Controls2, Controls3, Controls4]).

%-----------------------------------------------------------------------------%

    % Create a phrase describing how the top procedures may be sorted.
    %
:- func cost_criteria_to_description(cost_kind, include_descendants,
    measurement_scope) = string.

cost_criteria_to_description(CostKind, InclDesc, Scope) = Desc :-
    Desc =
        "ordered by " ++
        incl_desc_to_description(InclDesc) ++ " " ++
        cost_kind_to_description(CostKind) ++ " " ++
        scope_to_description(Scope).

    % Give the short name for what profiling data a field may be measuring.
    %
:- func incl_desc_to_description(include_descendants) = string.

incl_desc_to_description(self) = "self".
incl_desc_to_description(self_and_desc) = "total".

    % Describe the a measurement used by the deep profiler.
    %
:- func cost_kind_to_description(cost_kind) = string.

cost_kind_to_description(cost_calls)    = "number of calls".
cost_kind_to_description(cost_redos)    = "number of redos".
cost_kind_to_description(cost_time)     = "time".
cost_kind_to_description(cost_callseqs) = "call sequence numbers".
cost_kind_to_description(cost_allocs)   = "memory allocations".
cost_kind_to_description(cost_words)    = "words allocated".

    % Describe a scope of profiling data.
    %
:- func scope_to_description(measurement_scope) = string.

scope_to_description(per_call) = "per call".
scope_to_description(overall) = "overall".

%-----------------------------------------------------------------------------%

    % TODO: Generalize this type so it can be used for most tables shown by the
    % deep profilier.
:- type table_info
    --->    table_info(
                table_class     :: table_class,
                table_ranked    :: ranked,
                prefs           :: preferences,
                table_ordering  :: report_ordering
            ).

:- pred top_procs_table(preferences::in, report_ordering::in,
    list(row_data(report_proc))::in, table::out) is det.

top_procs_table(Prefs, Ordering, TopProcs, Table) :-
    TableInfo = table_info(table_class_top_procs, ranked, Prefs, Ordering),
    proc_table(TableInfo, TopProcs, Table).

%-----------------------------------------------------------------------------%
% Code for creating procedure tables.
%-----------------------------------------------------------------------------%

%
% TODO: The code in this section should be generalised as new reports are added
% which may have simliar tables.
%

    % Describes weather a table should be ranked or not,  This means that each
    % item has an ordinal number associated with it in an initial column
    % labeled "Rank".
    %
:- type ranked
    --->    ranked
    ;       non_ranked.

    % Produce a table for all these procedures.
    %
:- pred proc_table(table_info::in, list(row_data(report_proc))::in, table::out)
    is det. 

proc_table(TableInfo, TopProcs, Table) :-
    % Later add support for non-ranked tables.
    proc_table_header(TableInfo, NumCols, Header),
    map_foldl(proc_table_row(TableInfo), TopProcs, Rows, 1, _),
    Table = table(TableInfo ^ table_class, NumCols, yes(Header), Rows).

    % Common column header strings.
    %
:- func percall = table_data.
percall = s("/call").
:- func percent_label = table_data.
percent_label = s("%").
:- func self = table_data.
self = s("Self").

:- func make_link(report_ordering, preferences, string, cost_kind,
    include_descendants, measurement_scope) = deep_link.

make_link(Ordering, Prefs, Label, CostKind, InclDesc, Scope) = 
    make_link(Ordering, Prefs, Label, CostKind, InclDesc, Scope, 
        link_class_link).

:- func make_link(report_ordering, preferences, string, cost_kind,
    include_descendants, measurement_scope, link_class) = deep_link.

    % It might be nice to improve this so that if a user is looking up a
    % different cost kind compared to the current run it resets the display
    % limit.  This requires more thought, as different values may not make
    % sense for different limits.  So perhaps it's best to only reset the limit
    % if it was a range that didn't start at one.
    %
make_link(Ordering, Prefs, Label, CostKind, InclDesc, Scope, Class) = Link :-
    DisplayLimit = Ordering ^ display_limit,
    Link = deep_link(
        deep_cmd_top_procs(DisplayLimit, CostKind, InclDesc, Scope),
        yes(Prefs), Label, Class).

:- func make_table_link(table_info, string, cost_kind, include_descendants,
    measurement_scope) = table_data.

make_table_link(TableInfo, Label, CostKind, InclDesc, Scope) = 
        l(make_link(Ordering, Prefs, Label, CostKind, InclDesc, Scope)) :-
    Ordering = TableInfo ^ table_ordering,
    Prefs = TableInfo ^ prefs.

:- func self_link(table_info, cost_kind) = table_data.
self_link(TableInfo, CostKind) = Link :-
    make_table_link(TableInfo, "Self", CostKind, self, overall) = Link.

:- func self_percall_link(table_info, cost_kind) = table_data.
self_percall_link(TableInfo, CostKind) = Link :-
    make_table_link(TableInfo, "/call", CostKind, self, per_call) = Link.

:- func total_link(table_info, cost_kind) = table_data.
total_link(TableInfo, CostKind) = Link :-
    make_table_link(TableInfo, "Total", CostKind, self_and_desc, overall) = Link.

:- func total_percall_link(table_info, cost_kind) = table_data.
total_percall_link(TableInfo, CostKind) = Link :-
    make_table_link(TableInfo, "/call", CostKind, self_and_desc, per_call) = Link.

:- func time_link(table_info) = table_data.
time_link(TableInfo) = Link :-
    make_table_link(TableInfo, "Time", cost_time, self, overall) = Link.

:- func total_time_link(table_info) = table_data.
total_time_link(TableInfo) = Link :-
    make_table_link(TableInfo, "Time", cost_time, self_and_desc, overall) = Link.


:- func time = table_data.
time = s("Time").
:- func total = table_data.
total = s("Total").

    % Convert row data of procedures from the deep profiler into a table row
    % accoding to the preferences.
    %
:- pred proc_table_row(table_info::in, 
    row_data(report_proc)::in, table_row::out, int::in, int::out) is det.

proc_table_row(TableInfo, RowData, table_row(Cells), Rank, Rank+1) :-
    Ranked = TableInfo ^ table_ranked,
    Prefs = TableInfo ^ prefs,
    Fields = Prefs ^ pref_fields,

    % An optional rank number.
    (
        Ranked = ranked,
        RankCells = [table_cell(i(Rank))]
    ;
        Ranked = non_ranked,
        RankCells = []
    ),

    % The name of the procedure,
    proc_to_cell(TableInfo, RowData ^ subject, ProcCell),

    % Build the port counts cells.
    PortFields = Fields ^ port_fields,
    (
        PortFields = port,
        Calls = RowData ^ calls,
        Exits = RowData ^ exits,
        Fails = RowData ^ fails,
        Redos = RowData ^ redos,
        Excps = RowData ^ excps,
        PortCells = [table_cell(i(Calls)), table_cell(i(Exits)),
            table_cell(i(Fails)), table_cell(i(Redos)),
            table_cell(i(Excps))]
    ;
        PortFields = no_port,
        PortCells = []
    ),

    % Build the time and ticks cells.
    TimeFields = Fields ^ time_fields,
    (
        TimeFields = no_time,
        TimeCells = []
    ;
        SelfTicksCell = table_cell(i(RowData ^ self_ticks)),
        SelfTimeCell = table_cell(t(RowData ^ self_time)),
        SelfTimePercentCell = table_cell(p(RowData ^ self_time_percent)),
        SelfTimePercallCell = table_cell(t(RowData ^ self_time_percall)),
        TicksCell = table_cell(i(RowData ^ ticks)),
        TimeCell = table_cell(t(RowData ^ time)),
        TimePercentCell = table_cell(p(RowData ^ time_percent)),
        TimePercallCell = table_cell(t(RowData ^ time_percall)),
        (
            TimeFields = ticks,
            TimeCells = [SelfTicksCell, SelfTimePercentCell, 
                TicksCell, TimePercentCell]
        ;
            TimeFields = time,
            TimeCells = [SelfTimeCell, SelfTimePercentCell, 
                TimeCell, TimePercentCell]
        ;
            TimeFields = ticks_and_time,
            TimeCells = [SelfTicksCell, SelfTimeCell, SelfTimePercentCell,
                TicksCell, TimeCell, TimePercentCell]
        ;
            TimeFields = time_and_percall,
            TimeCells = [SelfTimeCell, SelfTimePercentCell,
                    SelfTimePercallCell,
                TimeCell, TimePercentCell, TimePercallCell]
        ;
            TimeFields = ticks_and_time_and_percall,
            TimeCells = [SelfTicksCell, SelfTimeCell, SelfTimePercentCell, 
                    SelfTimePercallCell,
                TicksCell, TimeCell, TimePercentCell, TimePercallCell]
        )
    ),

    % Build call sequence numbers cells.
    CallSeqsFields = Fields ^ callseqs_fields,
    (
        CallSeqsFields = no_callseqs,
        CallSeqsCells = []
    ;
        SelfCallseqsCell = table_cell(i(RowData ^ self_callseqs)),
        SelfCallseqsPercentCell = 
            table_cell(p(RowData ^ self_callseqs_percent)),
        CallseqsCell = table_cell(i(RowData ^ callseqs)),
        CallseqsPercentCell = table_cell(p(RowData ^ callseqs_percent)),
        (
            CallSeqsFields = callseqs,
            CallSeqsCells = [SelfCallseqsCell, SelfCallseqsPercentCell,
                CallseqsCell, CallseqsPercentCell]
        ;
            CallSeqsFields = callseqs_and_percall,
            SelfCallseqsPercallCell = 
                table_cell(f(RowData ^ self_callseqs_percall)),
            CallseqsPercallCell = table_cell(f(RowData ^ callseqs_percall)),
            CallSeqsCells = [SelfCallseqsCell, SelfCallseqsPercentCell, 
                    SelfCallseqsPercallCell,
                CallseqsCell, CallseqsPercentCell, CallseqsPercallCell]
        )
    ),
    
    % Build allocation info.
    AllocFields = Fields ^ alloc_fields,
    (
        AllocFields = no_alloc,
        AllocCells = []
    ;
        SelfAllocsCell = table_cell(i(RowData ^ self_allocs)),
        SelfAllocsPercentCell = table_cell(p(RowData ^ self_allocs_percent)),
        AllocsCell = table_cell(i(RowData ^ allocs)),
        AllocsPercentCell = table_cell(p(RowData ^ allocs_percent)),
        (
            AllocFields = alloc,
            AllocCells = [SelfAllocsCell, SelfAllocsPercentCell,
                AllocsCell, AllocsPercentCell]
        ;
            AllocFields = alloc_and_percall,
            SelfAllocsPercallCell = 
                table_cell(f(RowData ^ self_allocs_percall)),
            AllocsPercallCell = table_cell(f(RowData ^ allocs_percall)),
            AllocCells = [SelfAllocsCell, SelfAllocsPercentCell, 
                    SelfAllocsPercallCell,
                AllocsCell, AllocsPercentCell, AllocsPercallCell]
        )
    ),

    MemoryFields = Fields ^ memory_fields,
    (
        MemoryFields = no_memory,
        MemoryCells = []
    ;
        ( MemoryFields = memory(Units)
        ; MemoryFields = memory_and_percall(Units) ),
        SelfMemCell = table_cell(m(RowData ^ self_mem, Units, 0)),
        SelfMemPercallCell = 
            table_cell(m(RowData ^ self_mem_percall, Units, 2)),
        MemCell = table_cell(m(RowData ^ mem, Units, 0)),
        MemPercallCell = table_cell(m(RowData ^ mem_percall, Units, 2)),
        SelfMemPercentCell = table_cell(p(RowData ^ self_mem_percent)),
        MemPercentCell = table_cell(p(RowData ^ mem_percent)),
        (
            MemoryFields = memory(_),
            MemoryCells = [SelfMemCell, SelfMemPercentCell, 
                MemCell, MemPercentCell]
        ;
            MemoryFields = memory_and_percall(_),
            MemoryCells = [SelfMemCell, SelfMemPercentCell, SelfMemPercallCell,
                MemCell, MemPercentCell, MemPercallCell]
        )
    ),

    Cells = RankCells ++ cons(ProcCell, PortCells ++ TimeCells ++ 
        CallSeqsCells ++ AllocCells ++ MemoryCells). 


:- pred proc_to_cell(table_info::in, report_proc::in, table_cell::out) is det.

proc_to_cell(TableInfo, ReportProc, table_cell(Data)) :-
    Prefs = TableInfo ^ prefs,
    ReportProc = report_proc(PSPtr, _, _, Name),
    PSPtr = proc_static_ptr(PSIndex),
    Cmd = deep_cmd_proc(PSIndex),
    Data = l(deep_link(Cmd, yes(Prefs), Name, link_class_link)). 


    % Create the table header cell for the timing fields.
    %
:- pred proc_table_time_header(table_info::in, fields::in,
    maybe(table_header_cell)::out) is det.

proc_table_time_header(TableInfo, Fields, MaybeHeaderCell) :-
    TimeFields = Fields ^ time_fields,
    Self = self_link(TableInfo, cost_time),
    Time = time_link(TableInfo),
    SelfPercall = self_percall_link(TableInfo, cost_time),
    Total = total_link(TableInfo, cost_time),
    TotalTime = total_time_link(TableInfo),
    TotalPercall = total_percall_link(TableInfo, cost_time),

    (
        TimeFields = no_time, 
        MaybeHeaderCell = no
    ;
        (
            TimeFields = ticks,
            Title = "Clock ticks",
            SubTitles = [Self, percent_label, Total, percent_label]
        ;
            TimeFields = time,
            Title = "Time",
            SubTitles = [Self, percent_label, Total, percent_label]
        ; 
            TimeFields = ticks_and_time,
            Title = "Clock ticks and times",
            SubTitles = [Self, Time, percent_label, 
                Total, TotalTime, percent_label]
        ;
            TimeFields = time_and_percall,
            Title = "Time",
            SubTitles = [Self, percent_label, SelfPercall, 
                Total, percent_label, TotalPercall]
        ; 
            TimeFields = ticks_and_time_and_percall, 
            Title = "Clock ticks and times",
            SubTitles = [Self, Time, percent_label, SelfPercall, 
                Total, TotalTime, percent_label, TotalPercall]
        ),
        MaybeHeaderCell = yes(table_header_group(Title, SubTitles,
            table_col_class_ticks_and_times))
    ).

    % Build the ports section of the header if required.
    %
:- pred proc_table_ports_header(table_info::in, fields::in,
    maybe(table_header_cell)::out) is det.

proc_table_ports_header(TableInfo, Fields, MaybePortsHeader) :-
    (
        Fields ^ port_fields = port,
        Calls = make_table_link(TableInfo, "Calls", cost_calls, self, overall),
        Redos = make_table_link(TableInfo, "Redos", cost_redos, self, overall),
        MaybePortsHeader = yes(table_header_group("Port counts", 
            [Calls, s("Exits"), s("Fails"), Redos, s("Excps")],
            table_col_class_port_counts))
    ;
        Fields ^ port_fields = no_port,
        MaybePortsHeader = no
    ).

    % Create the table header cell for the call sequence count fields.
    %
:- pred proc_table_callseqs_header(table_info::in, fields::in,
    maybe(table_header_cell)::out) is det.

proc_table_callseqs_header(TableInfo, Fields, MaybeCallseqsHeader) :-
    Callseqs = Fields ^ callseqs_fields,
    Self = self_link(TableInfo, cost_callseqs),
    Total = total_link(TableInfo, cost_callseqs),
    (
        Callseqs = no_callseqs,
        MaybeCallseqsHeader = no
    ;
        (
            Callseqs = callseqs,
            SubTitles = [Self, percent_label, Total, percent_label]
        ;
            Callseqs = callseqs_and_percall,
            SelfPercall = self_percall_link(TableInfo, cost_callseqs),
            TotalPercall = total_percall_link(TableInfo, cost_callseqs),
            SubTitles = [Self, percent_label, SelfPercall, 
                Total, percent_label, TotalPercall]
        ),
        MaybeCallseqsHeader = yes(table_header_group("Call sequence numbers",
            SubTitles, table_col_class_callseqs))
    ).

    % Build the header for the allocations column group.
    %
:- pred proc_table_allocations_header(table_info::in, fields::in,
    maybe(table_header_cell)::out) is det.

proc_table_allocations_header(TableInfo, Fields, MaybeHeader) :-
    AllocFields = Fields ^ alloc_fields,
    Self = self_link(TableInfo, cost_allocs),
    Total = total_link(TableInfo, cost_allocs),
    (
        AllocFields = no_alloc,
        MaybeHeader = no
    ;
        (
            AllocFields = alloc,
            SubTitles = [Self, percent_label, Total, percent_label]
        ;
            AllocFields = alloc_and_percall,
            SelfPercall = self_percall_link(TableInfo, cost_allocs),
            TotalPercall = total_percall_link(TableInfo, cost_allocs),
            SubTitles = [Self, percent_label, SelfPercall, 
                Total, percent_label, TotalPercall]
        ),
        MaybeHeader = yes(table_header_group("Memory allocations", SubTitles,
            table_col_class_allocations))
    ).

    % Build the header for the memory usage column group.
    %
:- pred proc_table_memory_header(table_info::in, fields::in,
    maybe(table_header_cell)::out) is det.

proc_table_memory_header(TableInfo, Fields, MaybeHeader) :-
    Memory = Fields ^ memory_fields,
    Self = self_link(TableInfo, cost_words),
    Total = total_link(TableInfo, cost_words),
    Percent = percent_label,
    (
        Memory = no_memory,
        MaybeHeader = no
    ;
        (
            Memory = memory(Units),
            SubTitles = [Self, Percent, Total, Percent]
        ;
            Memory = memory_and_percall(Units),
            SelfPercall = self_percall_link(TableInfo, cost_words),
            TotalPercall = total_percall_link(TableInfo, cost_words),
            SubTitles = [Self, Percent, SelfPercall, 
                Total, Percent, TotalPercall]
        ),
        (
            Units = units_words,
            Title = "Memory words"
        ;
            Units = units_bytes,
            Title = "Memory bytes"
        ),
        MaybeHeader = yes(table_header_group(Title, SubTitles,
            table_col_class_memory))
    ).


    % Build a header for a table of procedures.
    %
:- pred proc_table_header(table_info::in, int::out, table_header::out) is det.

proc_table_header(TableInfo, NumCols, Header) :-
    Prefs = TableInfo ^ prefs,
    Ranked = TableInfo ^ table_ranked,
    Fields = Prefs ^ pref_fields,
    some [!NumCols, !Cols]
    (
        !:NumCols = 0,
        !:Cols = [],
        (
            Ranked = ranked,
            table_add_header_col(
                table_header_cell(s("Rank"), table_col_class_ordinal_rank), 
                !Cols, !NumCols)
        ;
            Ranked = non_ranked
        ),
        table_add_header_col(table_header_cell(s("Procedure"),
            table_col_class_proc), !Cols, !NumCols),
        
        proc_table_ports_header(TableInfo, Fields, MaybePortsHeader),
        table_maybe_add_header_col(MaybePortsHeader, !Cols, !NumCols),
        
        proc_table_time_header(TableInfo, Fields, MaybeTimeHeader),
        table_maybe_add_header_col(MaybeTimeHeader, !Cols, !NumCols),
       
        proc_table_callseqs_header(TableInfo, Fields, MaybeCallseqsHeader),
        table_maybe_add_header_col(MaybeCallseqsHeader, !Cols, !NumCols),

        proc_table_allocations_header(TableInfo, Fields,
            MaybeAllocationsHeader),
        table_maybe_add_header_col(MaybeAllocationsHeader, !Cols, !NumCols),

        proc_table_memory_header(TableInfo, Fields, MaybeMemoryHeader),
        table_maybe_add_header_col(MaybeMemoryHeader, !Cols, !NumCols),
        
        Header = table_header(reverse(!.Cols)),
        NumCols = !.NumCols
    ).

%-----------------------------------------------------------------------------%
% Code to build controls seen at bottom of reports.
%-----------------------------------------------------------------------------%

    % Build the sort controls.
    %
:- pred sort_controls(preferences::in, report_ordering::in, display_item::out)
    is det.

sort_controls(Prefs, Ordering, ControlsList) :- 
    CurrentCostKind = Ordering ^ cost_kind,
    Costs0 = [cost_calls, cost_redos, cost_time, cost_callseqs, cost_allocs,
        cost_words],
    list.filter(not_unify(CurrentCostKind), Costs0, Costs1), 
    list.map(make_sort_control(Ordering, Prefs), Costs1, Controls),

    ControlsList = display_list(list_class_horizontal, no, Controls).

:- pred cost_kind_label(cost_kind::in, string::out) is det.

cost_kind_label(cost_calls, "Sort by calls").
cost_kind_label(cost_redos, "Sort by redos").
cost_kind_label(cost_time, "Sort by time").
cost_kind_label(cost_callseqs, "Sort by call sequence numbers").
cost_kind_label(cost_allocs, "Sort by allocations").
cost_kind_label(cost_words, "Sort by words").

:- pred make_sort_control(report_ordering::in, preferences::in, 
    cost_kind::in, display_item::out) is det.

make_sort_control(Ordering, Prefs, CostKind, display_command_link(Control)) :-
    InclDesc = Ordering ^ incl_desc,
    Scope = Ordering ^ scope,
    cost_kind_label(CostKind, Label),
    Control = 
        make_link(Ordering, Prefs, Label, CostKind, InclDesc, Scope, 
            link_class_control).

%-----------------------------------------------------------------------------%

    % Create the controls for which measurements to include.
    %
:- pred incldesc_and_scope_controls(preferences::in, report_ordering::in, 
    display_item::out) is det.

incldesc_and_scope_controls(Prefs, Ordering, ControlsList) :-
    Ordering =
        report_ordering(DisplayLimit, CostKind, CurrentInclDesc, CurrentScope),
    
    % Build InclDesc Control.
    (
        CurrentInclDesc = self,
        InclDescLabel = "Include descendants",
        InclDesc = self_and_desc
    ;
        CurrentInclDesc = self_and_desc,
        InclDescLabel = "Exclude descendants",
        InclDesc = self
    ),
    InclDescControl = deep_link(
            deep_cmd_top_procs(DisplayLimit, CostKind, InclDesc, CurrentScope),
            yes(Prefs), InclDescLabel, link_class_control),
        
    % Build Scope Control.
    (
        CurrentScope = overall,
        ScopeLabel = "Count per-call cost",
        Scope = per_call
    ;
        CurrentScope = per_call,
        ScopeLabel = "Count overall cost",
        Scope = overall
    ),
    ScopeControl = deep_link(
            deep_cmd_top_procs(DisplayLimit, CostKind, CurrentInclDesc, Scope),
            yes(Prefs), ScopeLabel, link_class_control),

    map(link_to_display, [InclDescControl, ScopeControl], Controls), 
    ControlsList = display_list(list_class_horizontal, no, Controls).

    % Provide a predicate to be used as a higher order value that wraps the
    % display_command_link constructor.
    %
:- pred link_to_display(deep_link::in, display_item::out) is det.

link_to_display(Link, Display) :-
    display_command_link(Link) = Display.

%-----------------------------------------------------------------------------%

:- pred display_controls(preferences::in, cmd::in, display_item::out) is det. 

display_controls(Prefs, Cmd, ControlsList) :-
    Colour0 = Prefs ^ pref_colour,
    (
        Colour0 = colour_column_groups,
        Colour = colour_none,
        ColourLabel = "Fade column groups"
    ;
        Colour0 = colour_none,
        Colour = colour_column_groups,
        ColourLabel = "Colour column groups"
    ),
    ColourPrefs = Prefs ^ pref_colour := Colour,
    ColourControl = display_command_link(
        deep_link(Cmd, yes(ColourPrefs), ColourLabel, link_class_control)),

    Box0 = Prefs ^ pref_box,
    (
        Box0 = box,
        Box = nobox,
        BoxLabel = "Unbox"
    ;
        Box0 = nobox,
        Box = box,
        BoxLabel = "Box"
    ),
    BoxPrefs = Prefs ^ pref_box := Box,
    BoxControl = display_command_link(
        deep_link(Cmd, yes(BoxPrefs), BoxLabel, link_class_control)),

    ControlsList = display_list(list_class_horizontal, no, 
        [ColourControl, BoxControl]).

%-----------------------------------------------------------------------------%

    % Create the field controls section.
    %
:- pred field_controls(preferences::in, cmd::in, display_item::out) is det. 

field_controls(Prefs, Cmd, ControlsList) :-
    Fields = Prefs ^ pref_fields,
    Fields = fields(PortFields, TimeFields, CallseqsFields, AllocFields,
        MemoryFields),  

    (
        PortFields = no_port,
        Port = port
    ;
        PortFields = port,
        Port = no_port
    ),
    port_label(Port, PortLabel),
    NewPortFields = Fields ^ port_fields := Port,
    PortPrefs = Prefs ^ pref_fields := NewPortFields,
    PortControl = display_list(list_class_horizontal, no, [
        display_command_link(deep_link(Cmd, yes(PortPrefs), PortLabel,
        link_class_control))]),

    AllTimeFields = [no_time, ticks, time, ticks_and_time, time_and_percall,
        ticks_and_time_and_percall],
    list.filter(not_unify(TimeFields), AllTimeFields, NewTimeFields),
    list.map(make_time_control(Cmd, Prefs), NewTimeFields, TimeControls),
    make_horizontal_list(TimeControls, TimeControlsList),

    AllCallseqsFields = [no_callseqs, callseqs, callseqs_and_percall],
    list.filter(not_unify(CallseqsFields), AllCallseqsFields,
        NewCallseqsFields),
    list.map(make_callseqs_control(Cmd, Prefs), NewCallseqsFields,
        CallseqsControls),
    make_horizontal_list(CallseqsControls, CallseqsControlsList),

    AllAllocFields = [no_alloc, alloc, alloc_and_percall],
    list.filter(not_unify(AllocFields), AllAllocFields, NewAllocFields),
    list.map(make_alloc_control(Cmd, Prefs), NewAllocFields, AllocControls),
    make_horizontal_list(AllocControls, AllocControlsList),
   
    AllMemoryFields = [no_memory, memory(units_words), memory(units_bytes),
        memory_and_percall(units_words), memory_and_percall(units_bytes)],
    list.filter(not_unify(MemoryFields), AllMemoryFields, NewMemoryFields),
    list.map(make_memory_control(Cmd, Prefs), NewMemoryFields, MemoryControls),
    make_horizontal_list(MemoryControls, MemoryControlsList),

    Controls = [PortControl, TimeControlsList, CallseqsControlsList,
        AllocControlsList, MemoryControlsList],

    ControlsList = display_list(list_class_vertical_no_bullets, 
        yes("Toggle fields:"), Controls).

%-----------------------------------------------------------------------------%

    % Labels for the port fields controls.
    %
:- pred port_label(port_fields::in, string::out) is det.

port_label(port, "Port counts").
port_label(no_port, "No port counts").

%-----------------------------------------------------------------------------%

    % Make a time fields control using the given command and existing
    % preferences.  Makes a button to control which time fields are visible
    % depending on the third argument.
    %
:- pred make_time_control(cmd::in, preferences::in, 
    time_fields::in, display_item::out) is det.

make_time_control(Cmd, Prefs, TimeFields, Control) :-
    make_fields_control(update_time_fields, time_label,
        Cmd, Prefs, TimeFields, Control).

:- pred update_time_fields(time_fields::in, fields::in, fields::out)
    is det.

update_time_fields(TimeFields, !Fields) :-
    !:Fields = !.Fields ^ time_fields := TimeFields.

    % Labels for the time fields controls.
    %
:- pred time_label(time_fields::in, string::out) is det.

time_label(no_time, "No time info").
time_label(ticks, "Ticks").
time_label(time, "Times").
time_label(ticks_and_time, "Ticks and times").
time_label(time_and_percall, "Times and per-call times").
time_label(ticks_and_time_and_percall, "Ticks and times and per-call times").

%-----------------------------------------------------------------------------%

    % Make a callseqs fields control using the given commandv and existing
    % preferences.  Makes a button to control which callseqs fields are visible
    % depending on the third argument.
    %
:- pred make_callseqs_control(cmd::in, preferences::in, 
    callseqs_fields::in, display_item::out) is det.

make_callseqs_control(Cmd, Prefs, CallseqsFields, Control) :-
    make_fields_control(update_callseqs_fields, callseqs_label,
        Cmd, Prefs, CallseqsFields, Control).

:- pred update_callseqs_fields(callseqs_fields::in, fields::in, fields::out)
    is det.

update_callseqs_fields(CallseqsFields, !Fields) :-
    !:Fields = !.Fields ^ callseqs_fields := CallseqsFields.

:- pred callseqs_label(callseqs_fields::in, string::out) is det.

callseqs_label(no_callseqs, "No call sequence number info").
callseqs_label(callseqs, "Call sequence numbers").
callseqs_label(callseqs_and_percall, "Call sequence numbers including per-call").

%-----------------------------------------------------------------------------%

:- pred make_alloc_control(cmd::in, preferences::in, 
    alloc_fields::in, display_item::out) is det.

make_alloc_control(Cmd, Prefs, AllocFields, Control) :-
    make_fields_control(update_alloc_fields, alloc_label,
        Cmd, Prefs, AllocFields, Control).

:- pred update_alloc_fields(alloc_fields::in, fields::in, fields::out)
    is det.

update_alloc_fields(AllocFields, !Fields) :-
    !:Fields = !.Fields ^ alloc_fields := AllocFields.

:- pred alloc_label(alloc_fields::in, string::out) is det.

alloc_label(no_alloc, "No allocations").
alloc_label(alloc, "Allocations").
alloc_label(alloc_and_percall, "Allocations and per-call allocations").

%-----------------------------------------------------------------------------%

:- pred make_memory_control(cmd::in, preferences::in, 
    memory_fields::in, display_item::out) is det.

make_memory_control(Cmd, Prefs, MemoryFields, Control) :-
    make_fields_control(update_memory_fields, memory_label, Cmd, Prefs,
        MemoryFields, Control).

:- pred update_memory_fields(memory_fields::in, fields::in, fields::out) is det.

update_memory_fields(MemoryFields, !Fields) :-
    !:Fields = !.Fields ^ memory_fields := MemoryFields.

:- pred memory_label(memory_fields::in, string::out) is det.

memory_label(no_memory, "No memory info").
memory_label(memory(units_words), "Words").
memory_label(memory(units_bytes), "Bytes").
memory_label(memory_and_percall(units_words), "Words and per-call words").
memory_label(memory_and_percall(units_bytes), "Bytes and per-call bytes").

%-----------------------------------------------------------------------------%

:- pred make_fields_control(pred(T, fields, fields), pred(T, string),
    cmd, preferences, T, display_item).
:- mode make_fields_control(pred(in, in, out) is det, pred(in, out) is det,
    in, in, in, out) is det.

make_fields_control(UpdateFields, MakeLabel, Cmd, Prefs0, NewFields, Control) :-
    Fields0 = Prefs0 ^ pref_fields,
    UpdateFields(NewFields, Fields0, Fields),
    Prefs = Prefs0 ^ pref_fields := Fields,
    MakeLabel(NewFields, Label),
    Control = display_command_link(deep_link(Cmd, yes(Prefs), Label,
        link_class_control)).

%-----------------------------------------------------------------------------%
% Code shared within this module.
%-----------------------------------------------------------------------------%

    % Give the common list of commands seen at the bottom of all deep-profilier
    % displayed reports.
    %
:- func cmds_menu_restart_quit = list(display_item).

cmds_menu_restart_quit = [Menu, Restart, Quit] :-
    Menu = display_command_link(deep_link(deep_cmd_menu, no, "Menu", 
        link_class_control)),
    Restart = display_command_link(deep_link(deep_cmd_restart, no, "Restart",
        link_class_control)),
    Quit = display_command_link(deep_link(deep_cmd_quit, no, "Quit",
        link_class_control)).

%-----------------------------------------------------------------------------%

    % not_unify(A, B).
    %
    % This predicate is true when A \= B, and is usefull in higher order code.
    %
:- pred not_unify(T::in, T::in) is semidet.

not_unify(A, B) :-
    A \= B.
    
%-----------------------------------------------------------------------------%
    
    % Make a mercury list of display items into a display item representing a
    % horizontal list of these items.
    %
:- pred make_horizontal_list(list(display_item)::in, display_item::out) is det.

make_horizontal_list(Items, List) :-
    List = display_list(list_class_horizontal, no, Items).

%-----------------------------------------------------------------------------%
:- end_module display_report.
%-----------------------------------------------------------------------------%

-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
URL: <http://lists.mercurylang.org/archives/reviews/attachments/20080709/0d7dbcce/attachment.sig>


More information about the reviews mailing list