[m-rev.] diff: deforest I/O

[Zoltan Somogyi]

compiler/deforest.m:
	Use trace goals to print progress messages, to avoid the need for
	passing down I/O states to goals that do not otherwise need them.

	Give a more meaningful name to a predicate.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.88
diff -u -b -r1.88 deforest.m
--- compiler/deforest.m	23 Dec 2008 01:37:31 -0000	1.88
+++ compiler/deforest.m	14 Jul 2009 11:32:03 -0000
@@ -673,7 +673,7 @@
     DeforestInfo = deforest_info(EarlierGoal, _, BetweenGoals,
         LaterGoal, _, DeforestBranches),
 
-    should_try_deforestation(DeforestInfo, ShouldOptimize, !PDInfo, !IO),
+    should_try_deforestation(DeforestInfo, ShouldOptimize, !PDInfo),
     (
         ShouldOptimize = no,
         Optimized0 = no,
@@ -747,8 +747,8 @@
             Optimized0 = no
         )
     ),
-    check_improvement(Optimized0, CostDelta0, SizeDelta0, Optimized,
-        !.PDInfo, !IO),
+    Optimized = is_improvement_worth_while(!.PDInfo, Optimized0,
+        CostDelta0, SizeDelta0),
 
     % Clean up.
     pd_info_set_depth(Depth0, !PDInfo),
@@ -789,10 +789,10 @@
 
     % Check whether deforestation is legal and worthwhile.
     %
-:- pred should_try_deforestation(deforest_info::in,
-    bool::out, pd_info::in, pd_info::out, io::di, io::uo) is det.
+:- pred should_try_deforestation(deforest_info::in, bool::out,
+    pd_info::in, pd_info::out) is det.
 
-should_try_deforestation(DeforestInfo, ShouldTry, !PDInfo, !IO) :-
+should_try_deforestation(DeforestInfo, ShouldTry, !PDInfo) :-
     DeforestInfo = deforest_info(EarlierGoal, EarlierBranchInfo,
         BetweenGoals, LaterGoal, _, _),
     pd_info_get_useless_versions(!.PDInfo, UselessVersions),
@@ -802,7 +802,9 @@
         set.member(proc(PredId1, ProcId1) - proc(PredId2, ProcId2),
             UselessVersions)
     ->
-        pd_debug_message("version tried before, not worthwhile\n", [], !IO),
+        trace [compile_time(flag("debug_deforest")), io(!IO)] (
+            pd_debug_message("version tried before, not worthwhile\n", [], !IO)
+        ),
         ShouldTry = no
     ;
         % If some later goal depends on a variable such as an io.state
@@ -817,7 +819,9 @@
         set.intersect(OpaqueNonLocals, OpaqueVars, UsedOpaqueVars),
         \+ set.empty(UsedOpaqueVars)
     ->
-        pd_debug_message("later goals depend on opaque vars\n", [], !IO),
+        trace [compile_time(flag("debug_deforest")), io(!IO)] (
+            pd_debug_message("later goals depend on opaque vars\n", [], !IO)
+        ),
         ShouldTry = no
     ;
         ShouldTry = yes
@@ -845,7 +849,9 @@
     ->
         % The depth limit was exceeded. This should not occur too often in
         % practice - the depth limit is just a safety net.
-        pd_debug_message("\n\n*****Depth limit exceeded*****\n\n", [], !IO),
+        trace [compile_time(flag("debug_deforest")), io(!IO)] (
+            pd_debug_message("\n\n*****Depth limit exceeded*****\n\n", [], !IO)
+        ),
         ShouldTry = no
     ;
         % Check whether either of the goals to be deforested is too large.
@@ -936,28 +942,34 @@
     % - without any check at all the code size of the library only increases
     % ~10%.
     %
-:- pred check_improvement(bool::in, int::in, int::in, bool::out,
-    pd_info::in, io::di, io::uo) is det.
+:- func is_improvement_worth_while(pd_info, bool, int, int) = bool.
 
-check_improvement(Optimized0, CostDelta0, SizeDelta0, Optimized, PDInfo,
-        !IO) :-
+is_improvement_worth_while(PDInfo, Optimized0, CostDelta0, SizeDelta0)
+        = Optimized :-
     pd_info_get_cost_delta(PDInfo, CostDelta),
     pd_info_get_size_delta(PDInfo, SizeDelta),
     Improvement = CostDelta - CostDelta0,
     SizeDifference = SizeDelta - SizeDelta0,
-    globals.io_lookup_int_option(deforestation_cost_factor, Factor, !IO),
+
+    pd_info_get_module_info(PDInfo, ModuleInfo),
+    module_info_get_globals(ModuleInfo, Globals),
+    globals.lookup_int_option(Globals, deforestation_cost_factor, Factor),
     (
         Optimized0 = yes,
         check_deforestation_improvement(Factor, Improvement, SizeDifference)
     ->
         Optimized = yes,
+        trace [io(!IO)] (
         pd_debug_message("Enough improvement: cost(%i) size(%i)\n",
             [i(Improvement), i(SizeDifference)], !IO)
+        )
     ;
         Optimized = no,
+        trace [io(!IO)] (
         pd_debug_message(
             "Not enough improvement: cost(%i) size(%i)\n",
             [i(Improvement), i(SizeDifference)], !IO)
+        )
     ).
 
 %-----------------------------------------------------------------------------%
@@ -1960,8 +1972,10 @@
             )
         ->
             Goal = Goal4,
+            trace [io(!IO)] (
             pd_debug_message("inlined: cost(%i) size(%i)\n",
-                [i(CostDelta), i(SizeDelta)], !IO),
+                    [i(CostDelta), i(SizeDelta)], !IO)
+            ),
             pd_info_incr_size_delta(SizeDelta, !PDInfo),
             pd_info_set_changed(yes, !PDInfo),
             Goal0 = hlds_goal(_, GoalInfo0),
@@ -1980,9 +1994,11 @@
 
             Optimized = yes
         ;
+            trace [io(!IO)] (
             pd_debug_message("not enough improvement - " ++
                 "not inlining: cost(%i) size(%i)\n",
-                [i(CostDelta), i(SizeDelta)], !IO),
+                    [i(CostDelta), i(SizeDelta)], !IO)
+            ),
             pd_info_set_pred_info(PredInfo0, !PDInfo),
             pd_info_set_proc_info(ProcInfo0, !PDInfo),
             pd_info_set_size_delta(SizeDelta0, !PDInfo),
@@ -1992,7 +2008,9 @@
             Optimized = no
         )
     ;
-        pd_debug_message("too many variables - not inlining\n", [], !IO),
+        trace [io(!IO)] (
+            pd_debug_message("too many variables - not inlining\n", [], !IO)
+        ),
         Goal = Goal0,
         Optimized = no
     ).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------