[m-rev.] for post-commit review: fix switch_detection.m

Zoltan Somogyi zs at cs.mu.OZ.AU
Fri Apr 7 11:32:35 AEST 2006


For both branches.

Zoltan.

compiler/switch_detection.m:
	Fix a limitation: recognize switches in which *all* arms contain
	not a single unification of the switched-on variable but a disjunction
	of such unifications.

	Fix some misleading variable names.

tests/hard_coded/disjs_in_switch.{m,exp}:
	Add a test case for this bug.

tests/hard_coded/Mmakefile:
	Enable the new test case.

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/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.122
diff -u -b -r1.122 switch_detection.m
--- compiler/switch_detection.m	29 Mar 2006 08:07:23 -0000	1.122
+++ compiler/switch_detection.m	6 Apr 2006 09:05:33 -0000
@@ -433,13 +433,15 @@
     map.init(Cases0),
     partition_disj_trial(Goals0, Var, [], Left1, Cases0, Cases1),
     map.to_assoc_list(Cases1, CasesAssocList1),
-    CasesAssocList1 = [_ | _], % There must be at least one case.
     (
         Left1 = [],
+        CasesAssocList1 = [_ | _], % There must be at least one case.
         Left = Left1,
         fix_case_list(CasesAssocList1, GoalInfo, CasesList)
     ;
         Left1 = [_ | _],
+        % We don't insist on CasesAssocList1 not being empty, to allow for
+        % switches in which *all* cases contain subsidiary disjunctions.
         ( expand_sub_disjs(Var, Left1, Cases1, Cases) ->
             Left = [],
             map.to_assoc_list(Cases, CasesAssocList),
@@ -589,21 +591,22 @@
     prog_substitution::in, prog_substitution::out, Result::in, Result::out,
     Info::in, Info::out, deconstruct_search::out) is det.
 
-find_bind_var_2(Var, ProcessUnify, Goal0 - GoalInfo, Goal, !Subst, !Result,
-        !Info, FoundDeconstruct) :-
+find_bind_var_2(Var, ProcessUnify, Goal0, Goal, !Subst, !Result, !Info,
+        FoundDeconstruct) :-
+    Goal0 = GoalExpr0 - GoalInfo,
     (
-        Goal0 = scope(Reason, SubGoal0)
+        GoalExpr0 = scope(Reason, SubGoal0)
     ->
         find_bind_var_2(Var, ProcessUnify, SubGoal0, SubGoal, !Subst,
             !Result, !Info, FoundDeconstruct),
         Goal = scope(Reason, SubGoal) - GoalInfo
     ;
-        Goal0 = conj(ConjType, SubGoals0),
+        GoalExpr0 = conj(ConjType, SubGoals0),
         ConjType = plain_conj
     ->
         (
             SubGoals0 = [],
-            Goal = Goal0 - GoalInfo,
+            Goal = Goal0,
             FoundDeconstruct = before_deconstruct
         ;
             SubGoals0 = [_ | _],
@@ -612,7 +615,7 @@
             Goal = conj(ConjType, SubGoals) - GoalInfo
         )
     ;
-        Goal0 = unify(LHS, RHS, _, UnifyInfo0, _)
+        GoalExpr0 = unify(LHS, RHS, _, UnifyInfo0, _)
     ->
         (
             % Check whether the unification is a deconstruction unification
@@ -624,11 +627,11 @@
                 !.Subst, term.variable(SubstUnifyVar)),
             SubstVar = SubstUnifyVar
         ->
-            call(ProcessUnify, Var, Goal0 - GoalInfo, Goals, !Result, !Info),
+            call(ProcessUnify, Var, Goal0, Goals, !Result, !Info),
             conj_list_to_goal(Goals, GoalInfo, Goal),
             FoundDeconstruct = found_deconstruct
         ;
-            Goal = Goal0 - GoalInfo,
+            Goal = Goal0,
             FoundDeconstruct = before_deconstruct,
             % Otherwise abstractly interpret the unification.
             ( interpret_unify(LHS, RHS, !.Subst, NewSubst) ->
@@ -639,7 +642,7 @@
             )
         )
     ;
-        Goal = Goal0 - GoalInfo,
+        Goal = Goal0,
         ( goal_info_has_feature(GoalInfo, from_head) ->
             FoundDeconstruct = before_deconstruct
         ;
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/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/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_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/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/odbc
cvs diff: Diffing extras/posix
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/stream
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/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
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 tests
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
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.283
diff -u -b -r1.283 Mmakefile
--- tests/hard_coded/Mmakefile	5 Apr 2006 07:07:46 -0000	1.283
+++ tests/hard_coded/Mmakefile	6 Apr 2006 09:03:12 -0000
@@ -46,6 +46,7 @@
 	dense_lookup_switch2 \
 	dense_lookup_switch3 \
 	det_in_semidet_cntxt \
+	disjs_in_switch \
 	division_test \
 	dos \
 	dot_separator \
Index: tests/hard_coded/disjs_in_switch.exp
===================================================================
RCS file: tests/hard_coded/disjs_in_switch.exp
diff -N tests/hard_coded/disjs_in_switch.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/disjs_in_switch.exp	6 Apr 2006 09:10:16 -0000
@@ -0,0 +1,4 @@
+f or g
+f or g
+h or i
+h or i
Index: tests/hard_coded/disjs_in_switch.m
===================================================================
RCS file: tests/hard_coded/disjs_in_switch.m
diff -N tests/hard_coded/disjs_in_switch.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/disjs_in_switch.m	6 Apr 2006 08:48:55 -0000
@@ -0,0 +1,60 @@
+:- module disjs_in_switch.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- type t
+	--->	f(int)
+	;	g(int, int)
+	;	h(float)
+	;	i(string).
+
+:- type x
+	--->	xa
+	;	xb
+	;	xc
+	;	xd.
+
+main(!IO) :-
+	make_t(xa, T1),
+	test(T1, !IO),
+	make_t(xb, T2),
+	test(T2, !IO),
+	make_t(xc, T3),
+	test(T3, !IO),
+	make_t(xd, T4),
+	test(T4, !IO).
+
+:- pred test(t::in, io::di, io::uo) is det.
+
+test(T, !IO) :-
+	p(T, U),
+	io.write_string(U, !IO),
+	io.nl(!IO).
+
+:- pred make_t(x::in, t::out) is det.
+
+make_t(xa, f(0)).
+make_t(xb, g(1, 1)).
+make_t(xc, h(2.2)).
+make_t(xd, i("three")).
+
+:- pred p(t::in, string::out) is det.
+
+p(T, U) :-
+	(
+		( T = f(_)
+		; T = g(_, _)
+		),
+		U = "f or g"
+	;
+		( T = h(_)
+		; T = i(_)
+		),
+		U = "h or i"
+	).
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/recompilation
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:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list