Fix a limitation: recognize switches in which *all* arms contain

Estimated hours taken: 0.5
Branches: main

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.

compiler/switch_detection.m

@@ -433,13 +433,15 @@ partition_disj(Goals0, Var, GoalInfo, Left, CasesList, !Requant) :-
     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 @@ find_bind_var(Var, ProcessUnify, !Goal, !Result, !Info, FoundDeconstruct) :-
     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 @@ find_bind_var_2(Var, ProcessUnify, Goal0 - GoalInfo, Goal, !Subst, !Result,
             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 @@ find_bind_var_2(Var, ProcessUnify, Goal0 - GoalInfo, Goal, !Subst, !Result,
                 !.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 @@ find_bind_var_2(Var, ProcessUnify, Goal0 - GoalInfo, Goal, !Subst, !Result,
             )
         )
     ;
-        Goal = Goal0 - GoalInfo,
+        Goal = Goal0,
         ( goal_info_has_feature(GoalInfo, from_head) ->
             FoundDeconstruct = before_deconstruct
         ;

tests/hard_coded/Mmakefile

@@ -46,6 +46,7 @@ ORDINARY_PROGS=	\
 	dense_lookup_switch2 \
 	dense_lookup_switch3 \
 	det_in_semidet_cntxt \
+	disjs_in_switch \
 	division_test \
 	dos \
 	dot_separator \

tests/hard_coded/disjs_in_switch.exp

@@ -0,0 +1,4 @@
+f or g
+f or g
+h or i
+h or i

tests/hard_coded/disjs_in_switch.m

@@ -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"
+	).