[m-rev.] diff: avoid rtti_varmaps problems in follow_code
Mark Brown
mark at csse.unimelb.edu.au
Wed Mar 26 22:01:03 AEDT 2008
Hi,
This fixes two problems compiling G12 in debug grades, so I'll go
ahead and commit this now.
Cheers,
Mark.
Estimated hours taken: 5
Branches: main
Avoid bug #54.
compiler/follow_code.m:
Don't move existentially typed deconstructions into branched
control structures. If they were moved, there would be more than
one origin for the type(class)_infos produced by the deconstruction,
and the rtti_varmaps structure is not able to handle this.
tests/hard_coded/Mmakefile:
tests/hard_coded/follow_code_bug.exp:
tests/hard_coded/follow_code_bug.m:
tests/hard_coded/follow_code_bug_2.exp:
tests/hard_coded/follow_code_bug_2.m:
Two new test cases.
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.94
diff -u -r1.94 follow_code.m
--- compiler/follow_code.m 27 Feb 2008 07:23:05 -0000 1.94
+++ compiler/follow_code.m 26 Mar 2008 10:47:47 -0000
@@ -48,6 +48,7 @@
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.quantification.
:- import_module libs.compiler_util.
@@ -75,7 +76,7 @@
proc_info_get_vartypes(!.ProcInfo, VarTypes0),
proc_info_get_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
(
- move_follow_code_in_goal(Goal0, Goal1, no, Changed),
+ move_follow_code_in_goal(Goal0, Goal1, RttiVarMaps0, no, Changed),
Changed = yes
->
% We need to fix up the goal_info by recalculating the nonlocal
@@ -104,47 +105,50 @@
%-----------------------------------------------------------------------------%
:- pred move_follow_code_in_goal(hlds_goal::in, hlds_goal::out,
- bool::in, bool::out) is det.
+ rtti_varmaps::in, bool::in, bool::out) is det.
-move_follow_code_in_goal(Goal0, Goal, !Changed) :-
+move_follow_code_in_goal(Goal0, Goal, RttiVarMaps, !Changed) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
ConjPurity = goal_info_get_purity(GoalInfo),
- move_follow_code_in_conj(Goals0, ConjPurity, Goals, !Changed)
+ move_follow_code_in_conj(Goals0, ConjPurity, RttiVarMaps, Goals,
+ !Changed)
;
ConjType = parallel_conj,
- move_follow_code_in_independent_goals(Goals0, Goals, !Changed)
+ move_follow_code_in_independent_goals(Goals0, Goals, RttiVarMaps,
+ !Changed)
),
GoalExpr = conj(ConjType, Goals),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = disj(Goals0),
- move_follow_code_in_independent_goals(Goals0, Goals, !Changed),
+ move_follow_code_in_independent_goals(Goals0, Goals, RttiVarMaps,
+ !Changed),
GoalExpr = disj(Goals),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = negation(SubGoal0),
- move_follow_code_in_goal(SubGoal0, SubGoal, !Changed),
+ move_follow_code_in_goal(SubGoal0, SubGoal, RttiVarMaps, !Changed),
GoalExpr = negation(SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = switch(Var, Det, Cases0),
- move_follow_code_in_cases(Cases0, Cases, !Changed),
+ move_follow_code_in_cases(Cases0, Cases, RttiVarMaps, !Changed),
GoalExpr = switch(Var, Det, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- move_follow_code_in_goal(Cond0, Cond, !Changed),
- move_follow_code_in_goal(Then0, Then, !Changed),
- move_follow_code_in_goal(Else0, Else, !Changed),
+ move_follow_code_in_goal(Cond0, Cond, RttiVarMaps, !Changed),
+ move_follow_code_in_goal(Then0, Then, RttiVarMaps, !Changed),
+ move_follow_code_in_goal(Else0, Else, RttiVarMaps, !Changed),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = scope(Remove, SubGoal0),
- move_follow_code_in_goal(SubGoal0, SubGoal, !Changed),
+ move_follow_code_in_goal(SubGoal0, SubGoal, RttiVarMaps, !Changed),
GoalExpr = scope(Remove, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
@@ -167,25 +171,27 @@
% parallel conjunction.
%
:- pred move_follow_code_in_independent_goals(list(hlds_goal)::in,
- list(hlds_goal)::out, bool::in, bool::out) is det.
+ list(hlds_goal)::out, rtti_varmaps::in, bool::in, bool::out) is det.
-move_follow_code_in_independent_goals([], [], !Changed).
+move_follow_code_in_independent_goals([], [], _, !Changed).
move_follow_code_in_independent_goals([Goal0 | Goals0], [Goal | Goals],
- !Changed) :-
- move_follow_code_in_goal(Goal0, Goal, !Changed),
- move_follow_code_in_independent_goals(Goals0, Goals, !Changed).
+ RttiVarMaps, !Changed) :-
+ move_follow_code_in_goal(Goal0, Goal, RttiVarMaps, !Changed),
+ move_follow_code_in_independent_goals(Goals0, Goals, RttiVarMaps,
+ !Changed).
%-----------------------------------------------------------------------------%
:- pred move_follow_code_in_cases(list(case)::in, list(case)::out,
- bool::in, bool::out) is det.
+ rtti_varmaps::in, bool::in, bool::out) is det.
-move_follow_code_in_cases([], [], !Changed).
-move_follow_code_in_cases([Case0 | Cases0], [Case | Cases], !Changed) :-
+move_follow_code_in_cases([], [], _, !Changed).
+move_follow_code_in_cases([Case0 | Cases0], [Case | Cases], RttiVarMaps,
+ !Changed) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- move_follow_code_in_goal(Goal0, Goal, !Changed),
+ move_follow_code_in_goal(Goal0, Goal, RttiVarMaps, !Changed),
Case = case(MainConsId, OtherConsIds, Goal),
- move_follow_code_in_cases(Cases0, Cases, !Changed).
+ move_follow_code_in_cases(Cases0, Cases, RttiVarMaps, !Changed).
%-----------------------------------------------------------------------------%
@@ -193,23 +199,26 @@
% before and after it.
%
:- pred move_follow_code_in_conj(list(hlds_goal)::in, purity::in,
- list(hlds_goal)::out, bool::in, bool::out) is det.
+ rtti_varmaps::in, list(hlds_goal)::out, bool::in, bool::out) is det.
-move_follow_code_in_conj(Goals0, ConjPurity, Goals, !Changed) :-
- move_follow_code_in_conj_2(Goals0, ConjPurity, [], RevGoals, !Changed),
+move_follow_code_in_conj(Goals0, ConjPurity, RttiVarMaps, Goals, !Changed) :-
+ move_follow_code_in_conj_2(Goals0, ConjPurity, RttiVarMaps, [], RevGoals,
+ !Changed),
list.reverse(RevGoals, Goals).
:- pred move_follow_code_in_conj_2(list(hlds_goal)::in, purity::in,
- list(hlds_goal)::in, list(hlds_goal)::out, bool::in, bool::out) is det.
+ rtti_varmaps::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ bool::in, bool::out) is det.
-move_follow_code_in_conj_2([], _ConjPurity, !RevPrevGoals, !Changed).
-move_follow_code_in_conj_2([Goal0 | Goals0], ConjPurity, !RevPrevGoals,
- !Changed) :-
+move_follow_code_in_conj_2([], _ConjPurity, _RttiVarMaps, !RevPrevGoals,
+ !Changed).
+move_follow_code_in_conj_2([Goal0 | Goals0], ConjPurity, RttiVarMaps,
+ !RevPrevGoals, !Changed) :-
(
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
goal_util.goal_is_branched(GoalExpr0),
- move_follow_code_select(Goals0, FollowGoals, RestGoalsPrime,
- ConjPurity, WorstPurity),
+ move_follow_code_select(Goals0, RttiVarMaps, FollowGoals,
+ RestGoalsPrime, ConjPurity, WorstPurity),
FollowGoals = [_ | _],
% Moving any goals that bind variables into a model_semi (or model_det)
% disjunction gives that disjunction some outputs, which means that it
@@ -232,9 +241,10 @@
Goal1 = Goal0,
RestGoals = Goals0
),
- move_follow_code_in_goal(Goal1, Goal, !Changed),
+ move_follow_code_in_goal(Goal1, Goal, RttiVarMaps, !Changed),
!:RevPrevGoals = [Goal | !.RevPrevGoals],
- move_follow_code_in_conj_2(RestGoals, ConjPurity, !RevPrevGoals, !Changed).
+ move_follow_code_in_conj_2(RestGoals, ConjPurity, RttiVarMaps,
+ !RevPrevGoals, !Changed).
:- pred no_bind_vars(list(hlds_goal)::in) is semidet.
@@ -250,16 +260,39 @@
% Split a list of goals into the prefix of builtins and the rest.
%
-:- pred move_follow_code_select(list(hlds_goal)::in, list(hlds_goal)::out,
- list(hlds_goal)::out, purity::in, purity::out) is det.
-
-move_follow_code_select([], [], [], !Purity).
-move_follow_code_select([Goal | Goals], FollowGoals, RestGoals, !Purity) :-
+:- pred move_follow_code_select(list(hlds_goal)::in, rtti_varmaps::in,
+ list(hlds_goal)::out, list(hlds_goal)::out, purity::in, purity::out)
+ is det.
+
+move_follow_code_select([], _, [], [], !Purity).
+move_follow_code_select([Goal | Goals], RttiVarMaps, FollowGoals, RestGoals,
+ !Purity) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
- ( move_follow_code_is_builtin(GoalExpr) ->
+ (
+ move_follow_code_is_builtin(GoalExpr),
+
+ % Don't attempt to move existentially typed deconstructions
+ % into branched structures. Doing so would confuse the
+ % rtti_varmaps structure, which expects type(class)_infos
+ % for a given type variable (constraint) to be retrieved from
+ % a single location.
+ %
+ % XXX A better solution might be to introduce exists_cast goals,
+ % which would allow separate type variables for each branch and
+ % avoid the above confusion.
+ %
+ \+ (
+ GoalExpr = unify(_, _, _, Unification, _),
+ Unification = deconstruct(_, _, Args, _, _, _),
+ list.member(Arg, Args),
+ rtti_varmaps_var_info(RttiVarMaps, Arg, RttiVarInfo),
+ RttiVarInfo \= non_rtti_var
+ )
+ ->
GoalPurity = goal_info_get_purity(GoalInfo),
!:Purity = worst_purity(!.Purity, GoalPurity),
- move_follow_code_select(Goals, FollowGoals0, RestGoals, !Purity),
+ move_follow_code_select(Goals, RttiVarMaps, FollowGoals0, RestGoals,
+ !Purity),
FollowGoals = [Goal | FollowGoals0]
;
FollowGoals = [],
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.343
diff -u -r1.343 Mmakefile
--- tests/hard_coded/Mmakefile 19 Mar 2008 05:30:01 -0000 1.343
+++ tests/hard_coded/Mmakefile 26 Mar 2008 10:47:47 -0000
@@ -86,6 +86,8 @@
float_map \
float_reg \
float_rounding_bug \
+ follow_code_bug \
+ follow_code_bug_2 \
foreign_and_mercury \
foreign_enum_dummy \
foreign_enum_mod1 \
Index: tests/hard_coded/follow_code_bug.exp
===================================================================
RCS file: tests/hard_coded/follow_code_bug.exp
diff -N tests/hard_coded/follow_code_bug.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/follow_code_bug.exp 26 Mar 2008 10:47:47 -0000
@@ -0,0 +1,3 @@
+41
+forty-one
+foo
Index: tests/hard_coded/follow_code_bug.m
===================================================================
RCS file: tests/hard_coded/follow_code_bug.m
diff -N tests/hard_coded/follow_code_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/follow_code_bug.m 26 Mar 2008 10:47:47 -0000
@@ -0,0 +1,65 @@
+% vim: ts=4 sw=4 et
+:- module follow_code_bug.
+:- interface.
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+:- implementation.
+:- import_module string.
+
+main(!IO) :-
+ create_exist_data(int_data, IntData),
+ output_exist_data(IntData, !IO),
+ create_exist_data(string_data, StringData),
+ output_exist_data(StringData, !IO),
+ create_exist_data(foo_data, FooData),
+ output_exist_data(FooData, !IO).
+
+:- type data_type
+ ---> int_data
+ ; string_data
+ ; foo_data.
+
+:- type foo
+ ---> foo.
+
+:- some [T] pred create_exist_data(data_type::in, T::out) is det => data(T).
+
+create_exist_data(Type, ExistData) :-
+ (
+ Type = int_data,
+ Data = 'new data'(41)
+ ;
+ Type = string_data,
+ Data = 'new data'("forty-one")
+ ;
+ Type = foo_data,
+ Data = 'new data'(foo)
+ ),
+ Data = data(ExistData).
+
+:- pred output_exist_data(T::in, io::di, io::uo) is det <= data(T).
+
+output_exist_data(ExistData, !IO) :-
+ Str = to_string(ExistData),
+ io.write_string(Str, !IO),
+ io.nl(!IO).
+
+:- type data
+ ---> some [T] data(T) => data(T).
+
+:- typeclass data(T) where [
+ func to_string(T) = string
+ ].
+
+:- instance data(int) where [
+ (to_string(N) = int_to_string(N))
+ ].
+
+:- instance data(string) where [
+ (to_string(S) = S)
+ ].
+
+:- instance data(foo) where [
+ (to_string(_) = "foo")
+ ].
+
Index: tests/hard_coded/follow_code_bug_2.exp
===================================================================
RCS file: tests/hard_coded/follow_code_bug_2.exp
diff -N tests/hard_coded/follow_code_bug_2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/follow_code_bug_2.exp 26 Mar 2008 10:47:47 -0000
@@ -0,0 +1,3 @@
+41
+forty-one
+foo
Index: tests/hard_coded/follow_code_bug_2.m
===================================================================
RCS file: tests/hard_coded/follow_code_bug_2.m
diff -N tests/hard_coded/follow_code_bug_2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/follow_code_bug_2.m 26 Mar 2008 10:47:47 -0000
@@ -0,0 +1,80 @@
+% vim: ts=4 sw=4 et
+:- module follow_code_bug_2.
+:- interface.
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+:- implementation.
+:- import_module string.
+
+main(!IO) :-
+ create_exist_data(int_data, IntData),
+ output_exist_data(IntData, !IO),
+ create_exist_data(string_data, StringData),
+ output_exist_data(StringData, !IO),
+ create_exist_data(foo_data, FooData),
+ output_exist_data(FooData, !IO).
+
+:- type data_type
+ ---> int_data
+ ; string_data
+ ; foo_data.
+
+:- type foo
+ ---> foo.
+
+:- some [T] pred create_exist_data(data_type::in, T::out) is det => data(T).
+
+create_exist_data(Type, ExistData) :-
+ (
+ Type = int_data,
+ create_int_data(Data)
+ ;
+ Type = string_data,
+ create_string_data(Data)
+ ;
+ Type = foo_data,
+ create_foo_data(Data)
+ ),
+ Data = data(ExistData).
+
+:- pred create_int_data(data::out) is det.
+
+create_int_data(Data) :-
+ Data = 'new data'(41).
+
+:- pred create_string_data(data::out) is det.
+
+create_string_data(Data) :-
+ Data = 'new data'("forty-one").
+
+:- pred create_foo_data(data::out) is det.
+
+create_foo_data(Data) :-
+ Data = 'new data'(foo).
+
+:- pred output_exist_data(T::in, io::di, io::uo) is det <= data(T).
+
+output_exist_data(ExistData, !IO) :-
+ Str = to_string(ExistData),
+ io.write_string(Str, !IO),
+ io.nl(!IO).
+
+:- type data
+ ---> some [T] data(T) => data(T).
+
+:- typeclass data(T) where [
+ func to_string(T) = string
+ ].
+
+:- instance data(int) where [
+ (to_string(N) = int_to_string(N))
+ ].
+
+:- instance data(string) where [
+ (to_string(S) = S)
+ ].
+
+:- instance data(foo) where [
+ (to_string(_) = "foo")
+ ].
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the reviews
mailing list