[m-rev.] Various automatic parallelism changes.

Paul Bone pbone at csse.unimelb.edu.au
Thu Apr 2 20:48:39 AEDT 2009


Estimated hours taken: 20.
Branches: main

Various changes for automatic parallelism, the two major changes are:

Refactored some of the search for parallel conjunctions to use types that
describe the cost of a call site and the cost of a clique-procedure.  These
new types make it harder for programmers to mistakingly compare values of
either type accidentally.

Where possible, use the body of a clique to determine the cost of recursive
calls at the top level of recursion.  This improves the accuracy of this
calculation significantly.

deep_profiler/mdprof_fb.automatic_parallelism.m:
    As above.

deep_profiler/measurements.m:
    New cost data types as above.

deep_profiler/coverage.m:
    When coverage information completeness tests fail print out the procedure
    where the coverage information is incomplete.

deep_profiler/message.m:
    Introduce a new warning used in the automatic parallelism analysis.

deep_profiler/profile.m:
    Introduce a semidet version of deep_get_progrep_det.

mdbcomp/program_representation.m:
    Introduce a predicate to return the goal_rep from inside a case_rep
    structure.  This can be used as higher order code to turn a case list into
    a goal list for example.

deep_profiler/Mercury.options:
    Keep a commented out MCFLAGS definition that can be used to enable
    debugging output for the automatic parallelism analysis.

Index: deep_profiler/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/Mercury.options,v
retrieving revision 1.11
diff -u -p -b -r1.11 Mercury.options
--- deep_profiler/Mercury.options	12 Mar 2009 03:33:41 -0000	1.11
+++ deep_profiler/Mercury.options	2 Apr 2009 06:57:19 -0000
@@ -36,3 +36,8 @@ MCFLAGS-read_profile = 	--no-optimize-du
 MCFLAGS-startup = 	--no-optimize-duplicate-calls
 MCFLAGS-top_procs = 	--no-optimize-duplicate-calls
 
+# Uncomment this to debug the automatic parallelism code.
+#MCFLAGS-mdprof_fb.automatic_parallelism = \
+#	--trace-flag=debug_cpc_search \
+#	--trace-flag=debug_recursive_costs
+
Index: deep_profiler/coverage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/coverage.m,v
retrieving revision 1.1
diff -u -p -b -r1.1 coverage.m
--- deep_profiler/coverage.m	5 Nov 2008 03:38:40 -0000	1.1
+++ deep_profiler/coverage.m	30 Mar 2009 05:32:57 -0000
@@ -111,10 +111,11 @@ procrep_annotate_with_coverage(OwnProf, 
     some [!ProcDefn, !GoalRep] (
         !:ProcDefn = !.ProcRep ^ pr_defn,
         !:GoalRep = !.ProcDefn ^ pdr_goal,
+        ProcLabel = !.ProcRep ^ pr_id,
         Calls = calls(OwnProf),
         Exits = exits(OwnProf),
         Before = before_known(Calls),
-        CoverageReference = coverage_reference_info(CallSites,
+        CoverageReference = coverage_reference_info(ProcLabel, CallSites,
             SolnsCoveragePoints, BranchCoveragePoints),
         goal_annotate_coverage(CoverageReference, empty_goal_path,
             Before, After, !GoalRep),
@@ -132,6 +133,7 @@ procrep_annotate_with_coverage(OwnProf, 
     %
 :- type coverage_reference_info
     --->    coverage_reference_info(
+                cri_proc                    :: string_proc_label,
                 cri_call_sites              :: map(goal_path, call_site_perf),
                 cri_solns_coverage_points   :: map(goal_path, coverage_point),
                 cri_branch_coverage_points  :: map(goal_path, coverage_point)
@@ -241,8 +243,10 @@ goal_annotate_coverage(Info, GoalPath, B
     trace [compile_time(not flag("no_coverage_propagation_assertions"))] (
         require(check_coverage_complete(GoalCoverage, GoalExpr),
             string.format("check_coverage_complete failed\n" ++
-                "\tCoverage: %s\n\tGoalPath: %s\n",
-                [s(string(GoalCoverage)), s(goal_path_to_string(GoalPath))])),
+                "\tCoverage: %s\n\tGoalPath: %s\n\tProc: %s\n",
+                [s(string(GoalCoverage)), 
+                 s(goal_path_to_string(GoalPath)),
+                 s(string(Info ^ cri_proc))])),
         require(check_coverage_regarding_detism(GoalCoverage, Detism),
             string.format("check_coverage_regarding_detism failed: %s %s",
                     [s(string(GoalCoverage)), s(string(Detism))]))
Index: deep_profiler/mdprof_fb.automatic_parallelism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/mdprof_fb.automatic_parallelism.m,v
retrieving revision 1.1
diff -u -p -b -r1.1 mdprof_fb.automatic_parallelism.m
--- deep_profiler/mdprof_fb.automatic_parallelism.m	17 Mar 2009 06:27:07 -0000	1.1
+++ deep_profiler/mdprof_fb.automatic_parallelism.m	2 Apr 2009 09:42:54 -0000
@@ -63,6 +63,7 @@
 
 :- implementation.
 
+:- import_module coverage.
 :- import_module create_report.
 :- import_module mdbcomp.program_representation.
 :- import_module measurements.
@@ -103,8 +104,9 @@ candidate_parallel_conjunctions(Opts, De
     deep_lookup_clique_index(Deep, Deep ^ root, RootCliquePtr),
     TotalCallseqs = Deep ^ profile_stats ^ num_callseqs,
     % The +1 here accounts for the cost of the pseudo call into the mercury
-    % runtime.
-    RootCliqueCost = cost_info(1, TotalCallseqs + 1),
+    % runtime since it is modeled here as a call site that in reality does not
+    % exist.
+    RootCliqueCost = build_cs_cost_csq(1, float(TotalCallseqs) + 1.0),
     candidate_parallel_conjunctions_clique(Opts, Deep, RootCliqueCost, 
         RootCliquePtr, ConjunctionsMultiMap, Messages),
 
@@ -120,40 +122,35 @@ candidate_parallel_conjunctions(Opts, De
                 ipi_progrep         :: prog_rep,
                 ipi_opts            :: candidate_parallel_conjunctions_opts,
                 ipi_call_sites      :: map(goal_path, clique_call_site_report),
-                ipi_rec_call_sites  :: map(goal_path, cost_info),
+                ipi_rec_call_sites  :: map(goal_path, cs_cost_csq),
                 ipi_var_table       :: var_table
             ).
 
-:- type cost_info
-    --->    cost_info(
-                cci_calls           :: int,
-                cci_callseqs_total  :: int 
-            ).
-
 :- type candidate_par_conjunctions ==
     multi_map(string_proc_label, candidate_par_conjunction).
 
 :- pred candidate_parallel_conjunctions_clique(
-    candidate_parallel_conjunctions_opts::in, deep::in, cost_info::in,
+    candidate_parallel_conjunctions_opts::in, deep::in, cs_cost_csq::in,
     clique_ptr::in, candidate_par_conjunctions::out, cord(message)::out) 
     is det.
 
-candidate_parallel_conjunctions_clique(Opts, Deep, ParentCostInfo, CliquePtr,
+candidate_parallel_conjunctions_clique(Opts, Deep, ParentCSCostInfo, CliquePtr,
         Candidates, Messages) :-
     create_clique_report(Deep, CliquePtr, MaybeCliqueReport),
     (
         MaybeCliqueReport = ok(CliqueReport),
         CliqueProcs = CliqueReport ^ cr_clique_procs,
         % All cliques must contain at least one procedure.
-        ( [ FirstCliqueProcPrime ] = CliqueProcs ->
+        ( [ FirstCliqueProcPrime | _ ] = CliqueProcs ->
             FirstCliqueProc = FirstCliqueProcPrime
         ;
-            error(this_file ++ "A clique must have et least one procedure")
+            error(this_file ++ "A clique must have et least one procedure in " 
+                ++ string(CliquePtr))
         ),    
         CliqueIsRecursive = is_clique_recursive(CliqueReport),
         make_clique_proc_map(CliqueProcs, CliqueProcMap),
         candidate_parallel_conjunctions_clique_proc(Opts, Deep,
-            CliqueIsRecursive, ParentCostInfo, set.init, CliqueProcMap,
+            CliqueIsRecursive, ParentCSCostInfo, set.init, CliqueProcMap,
             CliquePtr, FirstCliqueProc, Candidates, Messages)
     ;
         MaybeCliqueReport = error(Error),
@@ -232,13 +229,13 @@ make_clique_proc_map(CliqueProcs, Clique
     %
 :- pred candidate_parallel_conjunctions_clique_proc(
     candidate_parallel_conjunctions_opts::in, deep::in, 
-    clique_is_recursive::in, cost_info::in, set(proc_desc)::in,
+    clique_is_recursive::in, cs_cost_csq::in, set(proc_desc)::in,
     map(proc_desc, clique_proc_report)::in,
     clique_ptr::in, clique_proc_report::in,
     candidate_par_conjunctions::out, cord(message)::out) is det.
 
 candidate_parallel_conjunctions_clique_proc(Opts, Deep, 
-        CliqueIsRecursive, ParentCostInfo, ProcsAnalysed0, CliqueProcMap, 
+        CliqueIsRecursive, ParentCSCostInfo, ProcsAnalysed0, CliqueProcMap, 
         CliquePtr, CliqueProc, Candidates, Messages) :-
     some [!Messages]
     (
@@ -248,8 +245,12 @@ candidate_parallel_conjunctions_clique_p
         % not contribute to the runtime of the program in an absolute way then
         % do not recurse further.  This test is performed here rather than in
         % the callees of this predicate to avoid duplication of code.
-        ParentCostInfo = cost_info(_Calls, TotalCost),
-        ( TotalCost > Opts ^ cpc_clique_threshold ->
+        TotalCost = cs_cost_get_total(ParentCSCostInfo),
+        ( TotalCost > float(Opts ^ cpc_clique_threshold) ->
+            CliqueProcCalls = CliqueProc ^ cpr_proc_summary ^ perf_row_calls,
+            cs_cost_to_proc_cost(ParentCSCostInfo, CliqueProcCalls, 
+            
+            ParentCostInfo),
             % Determine the costs of the call sites in the procedure.
             (
                 CliqueIsRecursive = clique_is_recursive,
@@ -302,14 +303,14 @@ candidate_parallel_conjunctions_clique_p
             Candidates = multi_map.init,
             trace [compile_time(flag("debug_cpc_search")), io(!IO)]
                 io.format("D: Not entering cheap clique: %s with cost %s\n",
-                    [s(string(CliquePtr)), s(string(ParentCostInfo))], !IO)
+                    [s(string(CliquePtr)), s(string(ParentCSCostInfo))], !IO)
         ),
         Messages = !.Messages
     ).
 
 :- pred candidate_parallel_conjunctions_call_site(
     candidate_parallel_conjunctions_opts::in, deep::in, set(proc_desc)::in,
-    clique_is_recursive::in, map(goal_path, cost_info)::in,
+    clique_is_recursive::in, map(goal_path, cs_cost_csq)::in,
     map(proc_desc, clique_proc_report)::in, clique_ptr::in,
     clique_call_site_report::in, candidate_par_conjunctions::out,
     cord(message)::out) is det.
@@ -330,7 +331,7 @@ candidate_parallel_conjunctions_call_sit
 
 :- pred candidate_parallel_conjunctions_callee(
     candidate_parallel_conjunctions_opts::in, deep::in, set(proc_desc)::in,
-    clique_is_recursive::in, map(goal_path, cost_info)::in,
+    clique_is_recursive::in, map(goal_path, cs_cost_csq)::in,
     map(proc_desc, clique_proc_report)::in, clique_ptr::in, call_site_desc::in,
     perf_row_data(clique_desc)::in, candidate_par_conjunctions::out,
     cord(message)::out) is det.
@@ -341,17 +342,6 @@ candidate_parallel_conjunctions_callee(O
     CliqueDesc = CliquePerf ^ perf_row_subject,
     CliquePtr = CliqueDesc ^ cdesc_clique_ptr,
     CliqueEntryProc = CliqueDesc ^ cdesc_entry_member,
-    MaybePerfTotal = CliquePerf ^ perf_row_maybe_total,
-    (
-        MaybePerfTotal = yes(PerfTotal)
-    ;
-        MaybePerfTotal = no,
-        error(this_file ++ 
-            "Could not retrive total callseqs cost from clique")
-    ),
-    CliqueCost = PerfTotal ^ perf_row_callseqs,
-    Calls = CliquePerf ^ perf_row_calls,
-    CostInfo = cost_info(Calls, CliqueCost),
     ( ParentCliquePtr = CliquePtr ->
         % This is a recursive call within the same clique.
         ( member(CliqueEntryProc, ProcsAnalysed0) ->
@@ -373,8 +363,9 @@ candidate_parallel_conjunctions_callee(O
                 Candidates, Messages)
         )
     ;
-        ( CliqueCost > Opts ^ cpc_clique_threshold ->
-            candidate_parallel_conjunctions_clique(Opts, Deep, CostInfo,
+        CSCost = build_cs_cost_from_perf(CliquePerf),
+        ( cs_cost_get_total(CSCost) > float(Opts ^ cpc_clique_threshold) ->
+            candidate_parallel_conjunctions_clique(Opts, Deep, CSCost,
                 CliquePtr, Candidates, Messages)
         ;
             Candidates = multi_map.init, 
@@ -385,97 +376,449 @@ candidate_parallel_conjunctions_callee(O
 %----------------------------------------------------------------------------%
 
 :- pred build_recursive_call_site_cost_map(deep::in, clique_proc_report::in,
-    clique_ptr::in, cost_info::in, map(goal_path, cost_info)::out,
+    clique_ptr::in, proc_cost_csq::in, map(goal_path, cs_cost_csq)::out,
     cord(message)::out) is det.
 
 build_recursive_call_site_cost_map(Deep, CliqueProc, CliquePtr,
-        ParentCostInfo, RecursiveCallSiteCostMap, Messages) :-
+        ParentCost, RecursiveCallSiteCostMap, Messages) :-
+    some [!Messages] (
+        !:Messages = cord.empty,
+
     % Lookup the proc static to find the ProcLabel.
     PerfRowData = CliqueProc ^ cpr_proc_summary,
-    TotalProcCalls = PerfRowData ^ perf_row_calls,
     ProcDesc = PerfRowData ^ perf_row_subject,
     proc_label_from_proc_desc(Deep, ProcDesc, ProcLabel),
 
     ( CliqueProc ^ cpr_other_proc_dynamics = [_ | _] ->
         append_message(proc(ProcLabel),
-            error_extra_proc_dynamics_in_clique_proc, cord.empty, Messages)
+                error_extra_proc_dynamics_in_clique_proc, !Messages)
     ;
-        Messages = cord.empty
+            true
     ),
-
-    cost_info(ParentCSCalls, ParentCSCost) = ParentCostInfo,
     CallSites = CliqueProc ^ cpr_first_proc_dynamic ^ cpdr_call_sites,
-    % Divide ParentCalls by the number of recursive calls to determine the
-    % fraction of calls into this procedure from outside the clique compared to
-    % calls from within the clique, use this to calculate the number of calls
-    % at the top level of the recursion of the call sites.
-    ProcCallsRecFraction = float(ParentCSCalls) / float(TotalProcCalls),
-    list.foldl3(get_callsite_cost_infos(CliquePtr, ProcCallsRecFraction), 
-        CallSites, 0, NonRecCSCost, 0.0, RecursiveCSCalls, 
-        set.init, RecursiveCS),
-
-    % The negative one here represents the call from the parent into this
-    % procedure.
-    RecursiveCost = ParentCSCost - 0 - NonRecCSCost,
-    ( RecursiveCSCalls = 0.0 ->
-        RecursiveCostPerCall = 0.0
-    ;
-        RecursiveCostPerCall = 
-            float(RecursiveCost) / RecursiveCSCalls
+       
+        PSPtr = ProcDesc ^ pdesc_ps_ptr,
+        create_procrep_coverage_report(Deep, PSPtr, MaybeCoverageReport),
+        (
+            MaybeCoverageReport = ok(procrep_coverage_info(_, ProcRep)),
+            Goal = ProcRep ^ pr_defn ^ pdr_goal,
+            foldl(add_call_site_to_map, CallSites, map.init, CallSiteMap),
+            goal_get_callsite_cost_info(CliquePtr, CallSiteMap, Goal,
+                empty_goal_path, Info),
+            Info = callsite_cost_info(NonRecCSCost, RecursiveCSCalls,
+                RecursiveCS, CallSiteProbabilityMap)
+        ;
+            MaybeCoverageReport = error(Error),
+            % If we couldn't find the proc rep then use the old method, this
+            % will not give accuruate call site probabilities.
+            foldl4(get_callsite_cost_info(CliquePtr, ParentCost), 
+                CallSites, 0.0, NonRecCSCost, 0.0, RecursiveCSCalls,
+                set.init, RecursiveCS, map.init, CallSiteProbabilityMap),
+            append_message(proc(ProcLabel),
+                warning_cannot_compute_procrep_coverage_fallback(Error), 
+                !Messages)
     ),
-    trace [compile_time(flag("debug_recursive_costs")), io(!IO)]
-        io.format(
-            "D: In clique proc: %s-%s\n\tRecursiveCostPerCall = %d/%f = %f\n",
-            [s(string(CliquePtr)), s(string(ProcLabel)), 
-             i(RecursiveCost), f(RecursiveCSCalls), f(RecursiveCostPerCall)], 
-            !IO),
 
+        % The cost of the recursive calls is the total cost minus the cost of
+        % the non recursive calls.
+        TotalRecursiveCost = 
+            proc_cost_get_total(ParentCost) - NonRecCSCost,
+
+        % This should never divide by zero since it is only called on code that
+        % is recursive at runtime, that is a recusrive call is executed.
+        RecursiveCostPerCall = TotalRecursiveCost / RecursiveCSCalls,
+
+        % Assign costs to call sites.
     set.fold(
-        build_recursive_call_site_cost_map_call_site(RecursiveCostPerCall),
-        RecursiveCS, map.init, RecursiveCallSiteCostMap). 
+            build_recursive_call_site_cost_map_call_site(RecursiveCostPerCall, 
+                CallSiteProbabilityMap),
+            RecursiveCS, map.init, RecursiveCallSiteCostMap),
+        Messages = !.Messages
+    ).
 
-:- pred get_callsite_cost_infos(clique_ptr::in, float::in, 
-    clique_call_site_report::in, int::in, int::out, float::in, float::out, 
-    set(clique_call_site_report)::in, set(clique_call_site_report)::out) is det.
+:- pred add_call_site_to_map(clique_call_site_report::in, 
+    map(goal_path, clique_call_site_report)::in,
+    map(goal_path, clique_call_site_report)::out) is det.
+
+add_call_site_to_map(CallSite, !Map) :-
+    GoalPath = CallSite ^ ccsr_call_site_summary ^ perf_row_subject 
+        ^ csdesc_goal_path,
+    svmap.det_insert(GoalPath, CallSite, !Map).
 
-get_callsite_cost_infos(ThisClique, ParentCallsRecFraction, CallSite,
-        !NonRecCSCost, !RecursiveCalls, !RecursiveCallSites) :-
+    % The stateful data of the goal_get_callsite_cost_info code below.
+    %
+:- type callsite_cost_info
+    --->    callsite_cost_info(
+                csci_non_rec_cs_cost    :: float,
+                csci_rec_calls          :: float,
+                csci_rec_cs             :: set(clique_call_site_report),
+                csci_cs_prob_map        :: map(goal_path, float)
+            ).
+
+:- func empty_callsite_cost_info = callsite_cost_info.
+
+empty_callsite_cost_info = callsite_cost_info(0.0, 0.0, set.init, map.init).
+
+:- pred goal_get_callsite_cost_info(clique_ptr::in,
+    map(goal_path, clique_call_site_report)::in, goal_rep(coverage_info)::in,
+    goal_path::in, callsite_cost_info::out) is det.
+
+goal_get_callsite_cost_info(CliquePtr, CallSites, Goal, GoalPath, Info) :-
+    Goal = goal_rep(GoalExpr, Detism, Coverage),
+    (
+        GoalExpr = conj_rep(Conjs),
+        conj_get_callsite_cost_info(CliquePtr, CallSites, Conjs, 1, GoalPath,
+            Info)
+    ;
+        GoalExpr = disj_rep(Disjs),
+        disj_get_callsite_cost_info(CliquePtr, CallSites, Detism, Coverage,
+            Disjs, GoalPath, Info)
+    ;
+        GoalExpr = switch_rep(_Var, _CanFail, Cases),
+        switch_get_callsite_cost_info(CliquePtr, CallSites, Coverage, Cases,
+            GoalPath, Info)
+    ;
+        GoalExpr = ite_rep(Cond, Then, Else),
+        ite_get_callsite_cost_info(CliquePtr, CallSites, Cond, Then, Else,
+            GoalPath, Info)
+    ;
+        (
+            GoalExpr = negation_rep(SubGoal),
+            SubGoalPath = goal_path_add_at_end(GoalPath, step_neg)
+        ;
+            GoalExpr = scope_rep(SubGoal, MaybeCut),
+            SubGoalPath = goal_path_add_at_end(GoalPath, step_scope(MaybeCut))
+        ),
+        goal_get_callsite_cost_info(CliquePtr, CallSites, SubGoal,
+            SubGoalPath, Info)
+    ;
+        GoalExpr = atomic_goal_rep(_, _, _, _AtomicGoal),
+        atomic_goal_get_callsite_cost_info(CliquePtr, CallSites, GoalPath,
+            Info)
+    ).
+
+:- pred atomic_goal_get_callsite_cost_info(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in, goal_path::in,
+    callsite_cost_info::out) is det.
+
+atomic_goal_get_callsite_cost_info(CliquePtr, CallSites, GoalPath, Info) :-
+    ( map.search(CallSites, GoalPath, CallSite) ->
+        svmap.det_insert(GoalPath, 1.0, map.init, CSProbMap),
+        ( call_site_is_recursive(CallSite, CliquePtr) ->
+            RecursiveCalls = 1.0,
+            NonRecursiveCost = 0.0,
+            RecursiveCallSites = set.from_list([CallSite])
+        ;
     CSSummary = CallSite ^ ccsr_call_site_summary,
     MaybeTotal = CSSummary ^ perf_row_maybe_total,
     (
         MaybeTotal = yes(Total),
-        Cost = Total ^ perf_row_callseqs
+                PercallCost = Total ^ perf_row_callseqs_percall
     ;
         MaybeTotal = no,
         error("clique_call_site has 'no' for perf_row_maybe_total")
     ),
+            RecursiveCalls = 0.0,
+            NonRecursiveCost = PercallCost,
+            RecursiveCallSites = set.init
+        ),
+        Info = callsite_cost_info(NonRecursiveCost, RecursiveCalls, 
+            RecursiveCallSites, CSProbMap)
+    ;
+        % Not a callsite, there is no information to update since atmoic
+        % non-call goals have a trivial cost. 
+        Info = empty_callsite_cost_info
+    ).
+
+:- pred conj_get_callsite_cost_info(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in,
+    list(goal_rep(coverage_info))::in, int::in,
+    goal_path::in, callsite_cost_info::out) is det.
+
+conj_get_callsite_cost_info(_, _, [], _, _, empty_callsite_cost_info).
+conj_get_callsite_cost_info(CliquePtr, CallSites, [Conj | Conjs], ConjNum,
+        GoalPath, Info) :-
+    ConjGoalPath = goal_path_add_at_end(GoalPath, step_conj(ConjNum)),
+    goal_get_callsite_cost_info(CliquePtr, CallSites, Conj, ConjGoalPath, 
+        ConjInfo),
+    
+    Coverage = Conj ^ goal_annotation,
+    ( get_coverage_before_and_after(Coverage, Calls, Exits) ->
+        % ContProb is the probability that this conjunction will continue with
+        % the execution of the next goal.
+        ( Calls = 0 ->
+            % If this was never called, then we will have a probability of 0 of
+            % executing the next conjunct.
+            ContProb = 0.0
+        ;
+            ContProb = float(Exits) / float(Calls)
+        )
+    ;
+        error(this_file ++ "Expected complete coverage information")
+    ),
+    conj_get_callsite_cost_info(CliquePtr, CallSites, Conjs, ConjNum + 1, 
+        GoalPath, ConjsInfo),
+    Info = multiply_and_add(ConjsInfo, ContProb, ConjInfo).
+
+:- pred disj_get_callsite_cost_info(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in, detism_rep::in,
+    coverage_info::in, list(goal_rep(coverage_info))::in,
+    goal_path::in, callsite_cost_info::out) is det.
+
+disj_get_callsite_cost_info(CliquePtr, CallSites, _Detism, Coverage,
+        Disjs, GoalPath, Info) :-
+    % Some disjunctions may have redos, however these are rare and are not
+    % modeled by this code.
+    list.map_foldl(
+        disj_get_callsite_cost_info2(CliquePtr, CallSites, GoalPath),
+        Disjs, DisjInfos, 1, _),
+    
+    map_corresponding_foldl2(
+        callsite_collect_branch_probabilities(Coverage),
+        Disjs, DisjInfos, Probs, 0.0, _NonRecProb, 0.0, _RecProb),
+    foldl_corresponding(
+        (pred(NewInfo::in, BranchProb::in, Info0I::in, InfoI::out) is det :-
+            % This is a special case of callsite_cost_merge_branches that is
+            % used for disjunctions.  Since disjunctions don't behave like
+            % switches or ITEs if a disjunct does not call recursive code it is
+            % still included as part of the code that would execute during a
+            % call that will recurse provided that some other disjuct recurses.
+            InfoI = multiply_and_add(NewInfo, BranchProb, Info0I)
+        ), DisjInfos, Probs, empty_callsite_cost_info, Info).
+
+:- pred disj_get_callsite_cost_info2(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in, goal_path::in,
+    goal_rep(coverage_info)::in, callsite_cost_info::out, int::in, int::out) 
+    is det.
+
+disj_get_callsite_cost_info2(CliquePtr, CallSites, GoalPath, Goal, Info,
+        DisjNum, DisjNum+1) :-
+    DisjGoalPath = goal_path_add_at_end(GoalPath, step_disj(DisjNum)),
+    goal_get_callsite_cost_info(CliquePtr, CallSites, Goal, DisjGoalPath,
+        Info).
+
+:- pred switch_get_callsite_cost_info(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in, coverage_info::in,
+    list(case_rep(coverage_info))::in, goal_path::in, callsite_cost_info::out)
+    is det.
+
+switch_get_callsite_cost_info(CliquePtr, CallSites, Coverage, Cases, GoalPath,
+        Info) :-
+    % Since switches are similar to disjunctions so some of this code is
+    % similar or shared.
+    list.map(case_get_goal, Cases, Goals),
+    list.map_foldl(
+        case_get_callsite_cost_info(CliquePtr, CallSites, GoalPath),
+        Goals, GoalInfos, 1, _),
+    map_corresponding_foldl2(
+        callsite_collect_branch_probabilities(Coverage),
+        Goals, GoalInfos, Probs, 0.0, NonRecProb, 0.0, RecProb),
+    foldl_corresponding(callsite_cost_merge_branches(NonRecProb, RecProb),
+        GoalInfos, Probs, empty_callsite_cost_info, Info).
+
+:- pred case_get_callsite_cost_info(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in, goal_path::in,
+    goal_rep(coverage_info)::in, callsite_cost_info::out, int::in, int::out) 
+    is det.
+
+case_get_callsite_cost_info(CliquePtr, CallSites, GoalPath, Goal, Info,
+        CaseNum, CaseNum+1) :-
+    CaseGoalPath = goal_path_add_at_end(GoalPath, step_switch(CaseNum, no)),
+    goal_get_callsite_cost_info(CliquePtr, CallSites, Goal, CaseGoalPath,
+        Info).
+
+:- pred ite_get_callsite_cost_info(clique_ptr::in, 
+    map(goal_path, clique_call_site_report)::in, 
+    goal_rep(coverage_info)::in, goal_rep(coverage_info)::in,
+    goal_rep(coverage_info)::in, goal_path::in, callsite_cost_info::out) is det.
+
+ite_get_callsite_cost_info(CliquePtr, CallSites, Cond, Then, Else,
+        GoalPath, Info) :-
+    CondGoalPath = goal_path_add_at_end(GoalPath, step_ite_cond),
+    ThenGoalPath = goal_path_add_at_end(GoalPath, step_ite_then),
+    ElseGoalPath = goal_path_add_at_end(GoalPath, step_ite_else),
+    goal_get_callsite_cost_info(CliquePtr, CallSites, Cond, CondGoalPath,
+        CondInfo),
+    goal_get_callsite_cost_info(CliquePtr, CallSites, Then, ThenGoalPath,
+        ThenInfo),
+    goal_get_callsite_cost_info(CliquePtr, CallSites, Else, ElseGoalPath,
+        ElseInfo),
+    
+    % Find the probability of entering either branch and merge the
+    % callsite_cost_info structures.
+    CondCoverage = Cond ^ goal_annotation,
+    ( get_coverage_before_and_after(CondCoverage, CondCalls, CondExits) ->
+        ( CondCalls = 0 ->
+            % XXX: I don't like these either since their sum is 0.0
+            ThenProb = 0.0,
+            ElseProb = 0.0
+        ;
+            ThenProb = float(CondExits) / float(CondCalls),
+            ElseProb = 1.0 - ThenProb
+        )
+    ;
+        error(this_file ++ "couldn't retrieve coverage information")
+    ),
+    add_probability_to_rec_non_rec_totals(ThenInfo, ThenProb, 
+        0.0, NonRecProb0, 0.0, RecProb0),
+    add_probability_to_rec_non_rec_totals(ElseInfo, ElseProb, 
+        NonRecProb0, NonRecProb, RecProb0, RecProb),
+    callsite_cost_merge_branches(NonRecProb, RecProb, ThenInfo, ThenProb, 
+        empty_callsite_cost_info, BranchInfo0),
+    callsite_cost_merge_branches(NonRecProb, RecProb, ElseInfo, ElseProb, 
+        BranchInfo0, BranchInfo),
+   
+    % Add the info from the condition goal.
+    Info = add_callsite_cost_info(CondInfo, BranchInfo).
+
+:- pred callsite_collect_branch_probabilities(coverage_info::in, 
+    goal_rep(coverage_info)::in, callsite_cost_info::in, float::out,
+    float::in, float::out, float::in, float::out) is det.
+
+callsite_collect_branch_probabilities(TotalCoverage, Goal, Info, Prob, 
+        !NonRecProb, !RecProb) :-
     (
-        % Note that according to this any higher order call site that is
-        % recursive in some cases and non-recursive in others is considered to
-        % be recursive.  The cost of it's non-recursive calls is not factored
-        % into the calculation of the cost of recursive call sites.
-        member(CalleePerf, CallSite ^ ccsr_callee_perfs),
-        CalleePerf ^ perf_row_subject ^ cdesc_clique_ptr = ThisClique
+        get_coverage_before(TotalCoverage, TotalCalls),
+        get_coverage_before(Goal ^ goal_annotation, Calls)
     ->
-        !:RecursiveCalls = !.RecursiveCalls + 
-            (float(CSSummary ^ perf_row_calls) * ParentCallsRecFraction),
+        % The probability of entering this branch given that the parent goal
+        % was called.
+        ( TotalCalls = 0 ->
+            % I'm not sure I'm comfortable with this, since in this case the
+            % probability of entering each branch will be 0.0, and the sum of
+            % this will be 0.0 which is not correct.
+            Prob = 0.0
+        ;
+            Prob = float(Calls) / float(TotalCalls)
+        )
+    ;
+        error(this_file ++ "could not retrieve coverage information")
+    ),
+    add_probability_to_rec_non_rec_totals(Info, Prob, !NonRecProb, !RecProb).
+
+:- pred add_probability_to_rec_non_rec_totals(callsite_cost_info::in, float::in,
+    float::in, float::out, float::in, float::out) is det.
+
+add_probability_to_rec_non_rec_totals(Info, Prob, !NonRecProb, !RecProb) :-
+    ( empty(Info ^ csci_rec_cs) ->
+        % This branch has no recursive calls in it (ie it forms a base-case),
+        % therefore it doesn't contribute to probability that we enter this
+        % branch since we're trying to calculate the probability of a goal
+        % being executed given that we're executing a procedure that will
+        % eventually recurse.  We track the probability of entering a
+        % non-recursive branch so that this probability can be added to the
+        % recursive cases below.
+        !:NonRecProb = !.NonRecProb + Prob
+    ;   
+        !:RecProb = !.RecProb + Prob
+    ).
+
+:- pred callsite_cost_merge_branches(float::in, float::in,
+    callsite_cost_info::in, float::in,
+    callsite_cost_info::in, callsite_cost_info::out) is det.
+
+callsite_cost_merge_branches(NonRecProb, RecProb, NewInfo, BranchProb, 
+        !Info) :-
+    ( empty(NewInfo ^ csci_rec_cs) ->
+        % This branch is non-recursive, therefore we don't count it's
+        % contribution to the execution time because we're calculating the
+        % execution time for a non-recursive invocation of this procedure.
+        true
+    ;
+        % Add the probability of a non-recursive branch to this branch weighted
+        % by the probability that we execute this branch given that we execute a
+        % recursive branch.
+        !:Info = multiply_and_add(NewInfo, 
+            BranchProb + (BranchProb / RecProb * NonRecProb), !.Info)
+    ).
+
+
+:- func multiply_and_add(callsite_cost_info, float, callsite_cost_info) =
+    callsite_cost_info.
+
+multiply_and_add(Cost, Scalar, CostAddend) = Result :-
+    Cost = callsite_cost_info(NonRecCSCost0, RecCalls0, RecCSA, CSProbMap0), 
+    CostAddend = callsite_cost_info(NonRecCSCostAddend, RecCallsAddend, RecCSB,
+        CSProbMapAddend), 
+    NonRecCSCost = (NonRecCSCost0 * Scalar) + NonRecCSCostAddend,
+    RecCalls = (RecCalls0 * Scalar) + RecCallsAddend,
+    % This set is simply 'added' multiplication doesn't make sense and merge is
+    % exactly what we want here.  Sets are given in this order for efficiency,
+    % see set.union/2
+    RecCS = set.union(RecCSB, RecCSA),
+    map.foldl(multiply_probability_merge(Scalar),
+        CSProbMap0, CSProbMapAddend, CSProbMap),
+    Result = callsite_cost_info(NonRecCSCost, RecCalls, RecCS, CSProbMap).
+
+:- pred multiply_probability_merge(float::in, goal_path::in, float::in,
+    map(goal_path, float)::in, map(goal_path, float)::out) is det.
+
+multiply_probability_merge(M, Key, Value0, !Map) :-
+    Value = Value0 * M,
+    svmap.det_insert(Key, Value, !Map).
+
+:- func add_callsite_cost_info(callsite_cost_info, callsite_cost_info) =
+    callsite_cost_info.
+
+add_callsite_cost_info(CSCIA, CSCIB) = 
+    multiply_and_add(CSCIA, 1.0, CSCIB).
+
+:- pred get_callsite_cost_info(clique_ptr::in, proc_cost_csq::in, 
+    clique_call_site_report::in, float::in, float::out, float::in, float::out, 
+    set(clique_call_site_report)::in, set(clique_call_site_report)::out,
+    map(goal_path, float)::in, map(goal_path, float)::out) is det.
+
+get_callsite_cost_info(ThisClique, ParentCost, CallSite, 
+        !NonRecCSCost, !RecursiveCalls, !RecursiveCallSites, !CallSiteProbMap)
+    :-
+    CSSummary = CallSite ^ ccsr_call_site_summary,
+    GoalPath = CSSummary ^ perf_row_subject ^ csdesc_goal_path,
+    CSCalls = float(CSSummary ^ perf_row_calls),
+    % Note that Prob represents the probability of this call occurring on any
+    % invocation of the clique proc, not on the top-level invocation of the
+    % clique proc which is what we take it to mean here.  This is why this
+    % method is not used with the procedure representation is available.
+    Prob = CSCalls / float(proc_cost_get_calls_total(ParentCost)),
+    svmap.det_insert(GoalPath, Prob, !CallSiteProbMap),
+    ( call_site_is_recursive(CallSite, ThisClique) ->
+        !:RecursiveCalls = !.RecursiveCalls + Prob, 
         svset.insert(CallSite, !RecursiveCallSites)
     ;
-        !:NonRecCSCost = !.NonRecCSCost + Cost
+        MaybeTotal = CSSummary ^ perf_row_maybe_total,
+        (
+            MaybeTotal = yes(Total),
+            PercallCost = Total ^ perf_row_callseqs_percall
+        ;
+            MaybeTotal = no,
+            error("clique_call_site has 'no' for perf_row_maybe_total")
+        ),
+        !:NonRecCSCost = !.NonRecCSCost + PercallCost
     ).
 
+:- pred call_site_is_recursive(clique_call_site_report::in, clique_ptr::in) 
+    is semidet.
+
+call_site_is_recursive(CallSite, ThisClique) :-
+    % Note that according to this any higher order call site that
+    % is recursive in some cases and non-recursive in others is
+    % considered to be recursive.  The cost of it's non-recursive
+    % calls is not factored into the calculation of the cost of
+    % recursive call sites.
+    member(CalleePerf, CallSite ^ ccsr_callee_perfs),
+    CalleePerf ^ perf_row_subject ^ cdesc_clique_ptr = ThisClique.
+
 :- pred build_recursive_call_site_cost_map_call_site(float::in,
-    clique_call_site_report::in, map(goal_path, cost_info)::in,
-    map(goal_path, cost_info)::out) is det.
+    map(goal_path, float)::in, clique_call_site_report::in, 
+    map(goal_path, cs_cost_csq)::in, map(goal_path, cs_cost_csq)::out) is det.
     
-build_recursive_call_site_cost_map_call_site(RecursiveCostPerCall, CallSite,
-        !Map) :-
+build_recursive_call_site_cost_map_call_site(RecursiveCostPerCall,
+        CallSiteProbabilityMap, CallSite, !Map) :-
     CSSummary = CallSite ^ ccsr_call_site_summary,
-    Calls = CSSummary ^ perf_row_calls,
-    Cost = RecursiveCostPerCall * float(Calls),
-    CostInfo = cost_info(Calls, round_to_int(Cost)),
     GoalPath = CSSummary ^ perf_row_subject ^ csdesc_goal_path,
-    svmap.det_insert(GoalPath, CostInfo, !Map).
+    
+    map.lookup(CallSiteProbabilityMap, GoalPath, Calls),
+    Cost = build_cs_cost_csq_percall(Calls, RecursiveCostPerCall),
+    svmap.det_insert(GoalPath, Cost, !Map).
 
 %----------------------------------------------------------------------------%
 
@@ -483,7 +826,7 @@ build_recursive_call_site_cost_map_call_
     %
 :- pred candidate_parallel_conjunctions_proc(
     candidate_parallel_conjunctions_opts::in, deep::in,
-    clique_proc_report::in, map(goal_path, cost_info)::in,
+    clique_proc_report::in, map(goal_path, cs_cost_csq)::in,
     candidate_par_conjunctions::out,
     cord(message)::out) is det.
 
@@ -929,8 +1272,15 @@ build_candidate_conjunctions(Info, InstM
         [MaybeCall | MaybeCalls], Messages, !Candidates) :-
     (
         MaybeCall = call(_, _, _, CallSiteReport),
-        PercallCost = percall_cost(get_call_site_cost(Info, CallSiteReport)),
-        ( PercallCost > float(Info ^ ipi_opts ^ cpc_call_site_threshold) ->
+        CallSiteCost = get_call_site_cost(Info, CallSiteReport),
+        (
+            ( cs_cost_get_calls(CallSiteCost) > 0.0 ->
+                PercallCost = cs_cost_get_percall(CallSiteCost),
+                PercallCost > float(Info ^ ipi_opts ^ cpc_call_site_threshold)
+            ;
+                fail 
+            )
+        ->
             % This conjunction is a call and is expensive enough to
             % parallelise, find some later conjunct to parallelise against it.
             build_candidate_conjunctions_2(Info, InstMap, GoalPath, ProcLabel,
@@ -940,13 +1290,13 @@ build_candidate_conjunctions(Info, InstM
         ;
             Messages0 = cord.empty,
             trace [compile_time(flag("debug_cpc_search")), io(!IO)]
-                io.format("D: Call too cheap: %s %s %f\n", 
+                io.format("D: Call too cheap: %s %s %s\n", 
                     [s(string(ProcLabel)), 
                      s(goal_path_to_string(CallSiteReport 
                         ^ ccsr_call_site_summary 
                         ^ perf_row_subject 
                         ^ csdesc_goal_path)),
-                     f(PercallCost)], !IO)
+                     s(string(CallSiteCost))], !IO)
         )
     ;
         MaybeCall = non_atomic_goal,
@@ -975,7 +1325,7 @@ build_candidate_conjunctions_2(Info, Ins
             MaybeCall = call(_, _, _, CallSiteReport),
             !:Messages = cord.empty,
             CallB = MaybeCall,
-            Cost = percall_cost(get_call_site_cost(Info, CallSiteReport)),
+            Cost = cs_cost_get_percall(get_call_site_cost(Info, CallSiteReport)),
             ( Cost > float(Info ^ ipi_opts ^ cpc_call_site_threshold) ->
                 % This conjunct is a call and is expensive enough to
                 % parallelise.
@@ -1083,39 +1433,25 @@ add_output_var_to_set(var_mode_and_use(V
     % Retrieve the average cost of a call site.
     %
 :- func get_call_site_cost(implicit_parallelism_info, clique_call_site_report) 
-    = cost_info.
+    = cs_cost_csq.
 
-get_call_site_cost(Info, CallSite) = CostInfo :-
+get_call_site_cost(Info, CallSite) = Cost :-
     CSSummary = CallSite ^ ccsr_call_site_summary,
     GoalPath = CSSummary ^ perf_row_subject ^ csdesc_goal_path,
-    ( map.search(Info ^ ipi_rec_call_sites, GoalPath, CostInfoPrime) ->
-        CostInfo = CostInfoPrime
+    ( map.search(Info ^ ipi_rec_call_sites, GoalPath, CostPrime) ->
+        Cost = CostPrime
     ;
         MaybePerfTotal = CSSummary ^ perf_row_maybe_total, 
         (
             MaybePerfTotal = yes(PerfTotal),
-            Cost = PerfTotal ^ perf_row_callseqs,
-            Calls = CSSummary ^ perf_row_calls
+            TotalCost = PerfTotal ^ perf_row_callseqs
         ;
             MaybePerfTotal = no,
             error(this_file ++ 
-                "Could not retrive total callseqs cost from call site")
+                "Could not retrieve total callseqs cost from call site")
         ),
-        CostInfo = cost_info(Calls, Cost)
-    ).
-
-    % Given a cost_info structure calculate the percall cost.
-    %
-:- func percall_cost(cost_info) = float.
-
-percall_cost(cost_info(Calls, Cost)) = PercallCost :-
-    ( Calls = 0 ->
-        % While this should be infinity or NaN if a call is never made then we
-        % don't know it's potential cost, it should probably not be
-        % parallelised and might as well be zero.
-        PercallCost = 0.0
-    ;
-        PercallCost = float(Cost) / float(Calls)
+        Calls = CSSummary ^ perf_row_calls,
+        Cost = build_cs_cost_csq(Calls, float(TotalCost))
     ).
 
 :- pred compute_independent_parallelisation_speedup(
@@ -1126,8 +1462,8 @@ percall_cost(cost_info(Calls, Cost)) = P
 
 compute_independent_parallelisation_speedup(Info, CallA, CallB, 
         CPCA, CPCB, Speedup) :-
-    CostA = percall_cost(get_call_site_cost(Info, CallA ^ mccc_call_site)),
-    CostB = percall_cost(get_call_site_cost(Info, CallB ^ mccc_call_site)),
+    CostA = cs_cost_get_percall(get_call_site_cost(Info, CallA ^ mccc_call_site)),
+    CostB = cs_cost_get_percall(get_call_site_cost(Info, CallB ^ mccc_call_site)),
     SequentialCost = CostA + CostB,
     ParallelCost = max(CostA, CostB) + 
         float(Info ^ ipi_opts ^ cpc_sparking_cost),
@@ -1145,8 +1481,8 @@ compute_independent_parallelisation_spee
 compute_optimal_dependant_parallelisation(Info, CallA, CallB,
         DepVars, _IntermediateGoals, InstMap, CPCA, CPCB,
         Speedup, Messages) :-
-    CostA = percall_cost(get_call_site_cost(Info, CallA ^ mccc_call_site)),
-    CostB = percall_cost(get_call_site_cost(Info, CallB ^ mccc_call_site)),
+    CostA = cs_cost_get_percall(get_call_site_cost(Info, CallA ^ mccc_call_site)),
+    CostB = cs_cost_get_percall(get_call_site_cost(Info, CallB ^ mccc_call_site)),
     SequentialCost = CostA + CostB,
     ( singleton_set(DepVars, DepVar) ->
         % Only parallelise conjunctions with a single dependant variable for
@@ -1260,7 +1596,7 @@ call_site_conj_to_candidate_par_conjunct
     Call = call(MaybeCallee, _Detism, Args, Perf),
     VarTable = Info ^ ipi_var_table,
     list.map(var_mode_use_to_var_in_par_conj(VarTable), Args, Vars),
-    Cost = percall_cost(get_call_site_cost(Info, Perf)),
+    Cost = cs_cost_get_percall(get_call_site_cost(Info, Perf)),
     CPC = candidate_par_conjunct(MaybeCallee, Vars, Cost).
 
 :- pred var_mode_use_to_var_in_par_conj(var_table::in, var_mode_and_use::in,
@@ -1415,6 +1751,21 @@ add_call_site_report_to_map(CallSite, !M
 
 this_file = "mdprof_fb.automatic_parallelism.m: ".
 
+:- func build_cs_cost_from_perf(perf_row_data(T)) = cs_cost_csq.
+
+build_cs_cost_from_perf(Perf) = CSCost :-
+    MaybePerfTotal = Perf ^ perf_row_maybe_total,
+    (
+        MaybePerfTotal = yes(PerfTotal)
+    ;
+        MaybePerfTotal = no,
+        error(this_file ++ 
+            "Could not retrieve total cost from perf data")
+    ),
+    TotalCSQ = PerfTotal ^ perf_row_callseqs,
+    Calls = Perf ^ perf_row_calls,
+    CSCost = build_cs_cost_csq(Calls, float(TotalCSQ)).
+
 %-----------------------------------------------------------------------------%
 :- end_module mdprof_fb.automatic_parallelism.
 %-----------------------------------------------------------------------------%
Index: deep_profiler/measurements.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/measurements.m,v
retrieving revision 1.13
diff -u -p -b -r1.13 measurements.m
--- deep_profiler/measurements.m	25 Aug 2008 07:19:39 -0000	1.13
+++ deep_profiler/measurements.m	2 Apr 2009 09:42:25 -0000
@@ -81,14 +81,71 @@
 :- func compute_is_active(own_prof_info) = is_active.
 
 %-----------------------------------------------------------------------------%
+
+:- type proc_cost_csq.
+
+:- type cs_cost_csq.
+
+    % build_proc_cost_csq(NRCalls, RCalls, TotalCost) = ParentCost.
+    %
+    % NRCalls: the number of non-recursive calls into this context.
+    % RCalls: the number of recursive (inc mutually-recursive) calls into this
+    % context.
+    %
+:- func build_proc_cost_csq(int, int, int) = proc_cost_csq.
+
+    % build_cs_cost_csq(Calls, TotalCost) = CallSiteCost.
+    %
+:- func build_cs_cost_csq(int, float) = cs_cost_csq.
+    
+    % build_cs_cost_csq_percall(Calls, PercallCost) = CallSiteCost.
+    %
+:- func build_cs_cost_csq_percall(float, float) = cs_cost_csq.
+
+    % Call site cost structure that has a zero cost and zero calls.
+    %
+:- func zero_cs_cost = cs_cost_csq.
+
+    % Retrieve the total cost of this context.
+    %
+:- func proc_cost_get_total(proc_cost_csq) = float.
+
+    % Retrive the number of calls made to this procedure.
+    %
+:- func proc_cost_get_calls_total(proc_cost_csq) = int.
+:- func proc_cost_get_calls_nonrec(proc_cost_csq) = int.
+:- func proc_cost_get_calls_rec(proc_cost_csq) = int.
+
+    % Retrieve the total cost of a call site.
+    %
+:- func cs_cost_get_total(cs_cost_csq) = float.
+
+    % Retrieve the per-call cost of a call site.
+    % Note that this may throw an exception if the number of calls is zero.
+    %
+:- func cs_cost_get_percall(cs_cost_csq) = float.
+
+    % Retrive the number of calls made from this call site.
+    %
+:- func cs_cost_get_calls(cs_cost_csq) = float.
+
+    % Convert a call site cost to a proc cost.
+    %
+:- pred cs_cost_to_proc_cost(cs_cost_csq::in, int::in, 
+    proc_cost_csq::out) is det.
+
+:- func cs_cost_per_proc_call(cs_cost_csq, proc_cost_csq) = cs_cost_csq.
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
+:- import_module float.
 :- import_module int.
 :- import_module string.
 
-%-----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
 
 :- type own_prof_info
     --->    own_prof_all(
@@ -406,5 +463,112 @@ compute_is_active(Own) = IsActive :-
     ).
 
 %----------------------------------------------------------------------------%
+
+:- type proc_cost_csq
+    --->    proc_cost_csq(
+                pcc_nr_calls        :: int,
+                    % The number of non-recursive calls into this context.  For
+                    % example if this is a clique this is the number of calls
+                    % made from the parent' clique to this one.
+                
+                pcc_r_calls         :: int,
+                    % The number of recursive calls into this context.  This
+                    % includes mutual recursion.
+                
+                pcc_csq             :: cost 
+                    % The number of callseq counts per call,
+            ).
+
+:- type cs_cost_csq
+    --->    cs_cost_csq(
+                cscc_calls          :: float,
+                    % The number of calls (per parent invocation) through this
+                    % call site.
+                
+                cscc_csq_cost       :: cost 
+                    % The cost of the call site per call.
+            ).
+
+%----------------------------------------------------------------------------%
+
+build_proc_cost_csq(NonRecursiveCalls, RecursiveCalls, TotalCost) = 
+    proc_cost_csq(NonRecursiveCalls, RecursiveCalls, 
+        cost_total(float(TotalCost))).
+
+proc_cost_get_total(proc_cost_csq(NRCalls, RCalls, Cost)) =
+    cost_get_total(float(NRCalls + RCalls), Cost).
+
+proc_cost_get_calls_total(proc_cost_csq(NRCalls, RCalls, _)) = 
+    NRCalls + RCalls.
+
+proc_cost_get_calls_nonrec(proc_cost_csq(NRCalls, _, _)) = NRCalls.
+
+proc_cost_get_calls_rec(proc_cost_csq(_, RCalls, _)) = RCalls.
+
+%----------------------------------------------------------------------------%
+
+build_cs_cost_csq(Calls, TotalCost) = 
+    cs_cost_csq(float(Calls), cost_total(TotalCost)).
+
+build_cs_cost_csq_percall(Calls, PercallCost) =
+    cs_cost_csq(Calls, cost_per_call(PercallCost)).
+
+zero_cs_cost =
+    % Build this using the percall structure so that if a percall cost is ever
+    % retrived we don't have to divide by zero.  This is only a partial
+    % solution.
+    build_cs_cost_csq_percall(0.0, 0.0).
+
+cs_cost_get_total(cs_cost_csq(Calls, Cost)) = 
+    cost_get_total(Calls, Cost).
+
+cs_cost_get_percall(cs_cost_csq(Calls, Cost)) =
+    cost_get_percall(Calls, Cost).
+
+cs_cost_get_calls(cs_cost_csq(Calls, _)) = Calls.
+
+%----------------------------------------------------------------------------%
+
+cs_cost_to_proc_cost(cs_cost_csq(CSCalls, CSCost), TotalCalls, 
+        proc_cost_csq(NRCalls, RCalls, PCost)) :-
+    NRCalls = round_to_int(CSCalls),
+    RCalls = TotalCalls - round_to_int(CSCalls),
+    % The negative one represents the cost of the callsite itsself.
+    PCost = cost_total(cost_get_total(CSCalls, CSCost) - 1.0 * CSCalls).
+
+cs_cost_per_proc_call(cs_cost_csq(CSCalls0, CSCost0), ParentCost) = 
+        cs_cost_csq(CSCalls, CSCost) :-
+    TotalParentCalls = proc_cost_get_calls_nonrec(ParentCost),
+    CSCalls = CSCalls0 / float(TotalParentCalls),
+    CSCost = CSCost0 / TotalParentCalls.
+
+%----------------------------------------------------------------------------%
+
+:- type cost
+    --->    cost_per_call(float)
+    ;       cost_total(float).
+
+:- func cost_get_total(float, cost) = float.
+
+cost_get_total(_, cost_total(Total)) = Total.
+cost_get_total(Calls, cost_per_call(PC)) = Calls * PC.
+
+:- func cost_get_percall(float, cost) = float.
+
+cost_get_percall(Calls, cost_total(Total)) = Total / Calls.
+cost_get_percall(_, cost_per_call(PC)) = PC.
+
+:- func (cost) / (int) = cost.
+
+Cost0 / Denom = Cost :-
+    (
+        Cost0 = cost_total(Total),
+        Cost = cost_total(Total / float(Denom))
+    ;
+        Cost0 = cost_per_call(Percall),
+        Cost = cost_per_call(Percall / float(Denom))
+    ).
+
+%----------------------------------------------------------------------------%
 :- end_module measurements.
 %----------------------------------------------------------------------------%
Index: deep_profiler/message.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/message.m,v
retrieving revision 1.1
diff -u -p -b -r1.1 message.m
--- deep_profiler/message.m	17 Mar 2009 06:27:07 -0000	1.1
+++ deep_profiler/message.m	30 Mar 2009 03:18:30 -0000
@@ -113,6 +113,12 @@
                 %
     ;       warning_cannot_lookup_proc_defn
 
+                % Couldn't compute the coverage annotation for a procedure
+                % representation.  A fallback method will be used but whithout
+                % this information it may be less accurate.
+                %
+    ;       warning_cannot_compute_procrep_coverage_fallback(string)
+
                 % We don't yet handle clique_proc_reports with multiple proc
                 % dynamics.
                 %
@@ -184,6 +190,8 @@ message_type_to_level(notice_cannot_para
 message_type_to_level(notice_callpair_has_more_than_one_dependant_var) =
     message_notice.
 message_type_to_level(warning_cannot_lookup_proc_defn) = message_warning.
+message_type_to_level(warning_cannot_compute_procrep_coverage_fallback(_)) =
+    message_warning.
 message_type_to_level(error_extra_proc_dynamics_in_clique_proc) = 
     message_error.
 message_type_to_level(error_coverage_procrep_error(_)) =
@@ -228,6 +236,10 @@ message_type_to_string(MessageType) = St
         String = "Could not look up proc defn, perhaps this procedure is"
             ++ " built-in"
     ;
+        MessageType = warning_cannot_compute_procrep_coverage_fallback(Error),
+        String = "Cannot compute procrep coverage annotation: " ++ Error 
+            ++ "\n  falling back to some other method"
+    ;
         MessageType = error_extra_proc_dynamics_in_clique_proc, 
         String = "extra proc dynamnics for a clique proc are not currenty"
             ++ " handled."
Index: deep_profiler/profile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/profile.m,v
retrieving revision 1.25
diff -u -p -b -r1.25 profile.m
--- deep_profiler/profile.m	12 Mar 2009 03:33:41 -0000	1.25
+++ deep_profiler/profile.m	30 Mar 2009 02:57:28 -0000
@@ -483,8 +483,12 @@
 
 %-----------------------------------------------------------------------------%
 
+    % Lookup the program representation data.
+    %
 :- pred deep_get_progrep_det(deep::in, prog_rep::out) is det.
 
+:- pred deep_get_progrep(deep::in, prog_rep::out) is semidet.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -998,18 +1002,19 @@ root_own_info(Deep) = RootOwn :-
 %-----------------------------------------------------------------------------%
 
 deep_get_progrep_det(Deep, ProgRep) :-
-    MaybeProgRep = Deep ^ procrep_file,
-    (
-        MaybeProgRep = yes(MaybeProgRep1),
+    ( deep_get_progrep(Deep, ProgRepPrime) ->
+        ProgRep = ProgRepPrime
+    ;
+        error(this_file ++ "Could not open Deep.procrep")
+    ).
+
+deep_get_progrep(Deep, ProgRep) :-
+    Deep ^ procrep_file = yes(MaybeProgRep1),
         (
             MaybeProgRep1 = ok(ProgRep)
         ;
             MaybeProgRep1 = error(Error),
             error(this_file ++ Error)
-        )
-    ;
-        MaybeProgRep = no,
-        error(this_file ++ "Could not open Deep.procrep")
     ).
 
 %-----------------------------------------------------------------------------%
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.46
diff -u -p -b -r1.46 program_representation.m
--- mdbcomp/program_representation.m	30 Jan 2009 03:51:45 -0000	1.46
+++ mdbcomp/program_representation.m	31 Mar 2009 07:24:09 -0000
@@ -408,6 +408,11 @@
 
 :- func head_var_to_var(head_var_rep) = var_rep.
 
+    % Extract the goal from a case, this is implemented here so it can be used
+    % in as a higher order value.
+    %
+:- pred case_get_goal(case_rep(T)::in, goal_rep(T)::out) is det.
+
 %-----------------------------------------------------------------------------%
 
     % Describe a call site.
@@ -806,6 +811,8 @@ atomic_goal_identifiable(event_call_rep(
 
 head_var_to_var(head_var_rep(Var, _)) = Var.
 
+case_get_goal(case_rep(_, _, Goal), Goal).
+
 :- pragma foreign_export("C", proc_defn_rep_type = out,
     "ML_proc_defn_rep_type").
 
-------------- 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/20090402/1641654d/attachment.sig>


More information about the reviews mailing list