[m-rev.] diff: fix a bug with parametric modes
Julien Fischer
juliensf at csse.unimelb.edu.au
Thu Sep 21 18:53:15 AEST 2006
Estimated hours taken: 1
Branches: main, release
Fix a bug with parametric modes. Mode specific clauses or foreign_export
pragmas that involved a parametric mode didn't work because the compiler
could not match the clause or foreign_export pragma with the corresponding
mode declaration. The problem here is that the inst varsets attached to
the mode declaration and clause or foreign_export pragma are not necessarily
the same so unifying the modes is not sufficient to prove that they match.
Since we have already fixed this problem for foreign_proc pragmas the fix here
is just to extend that solution to mode-specific clauses and foreign_export
pragmas. The fix is just to allow for a renaming between the inst variables.
(Note: I've also extended this fix to the termination_info and structure
sharing/reuse pragmas which could also be affected by this.)
compiler/add_pragma.m:
Use get_procedure_matching_declmodes_with_renaming/4 instead
of get_procedure_matching_declmodes/4. This fixes problems
with items that contain inst variables not matching the
corresponding mode declaration for that item.
Delete get_procedure_matching_declmodes/4 as it isn't used
anymore and is fundamentally broken w.r.t to the way inst
variables are currently handled inside the compiler.
Move some code around so that the predicates are in top-down
order.
compiler/add_clause.m:
Call get_procedure_matching_declmodes_with_renaming/4 instead
of get_procedure_matching_declmodes.
tests/valid/Mmakefile:
tests/valid/param_mode_bug.m:
Add a test case for the above.
Julien.
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.34
diff -u -r1.34 add_clause.m
--- compiler/add_clause.m 12 Sep 2006 04:42:48 -0000 1.34
+++ compiler/add_clause.m 16 Sep 2006 13:42:48 -0000
@@ -308,8 +308,8 @@
pred_info_get_procedures(PredInfo, Procs),
map.to_assoc_list(Procs, ExistingProcs),
(
- get_procedure_matching_declmodes(ExistingProcs, ModeList,
- !.ModuleInfo, ProcId)
+ get_procedure_matching_declmodes_with_renaming(ExistingProcs,
+ ModeList, !.ModuleInfo, ProcId)
->
ProcIds = [ProcId]
;
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.49
diff -u -r1.49 add_pragma.m
--- compiler/add_pragma.m 20 Sep 2006 09:42:02 -0000 1.49
+++ compiler/add_pragma.m 21 Sep 2006 08:03:08 -0000
@@ -114,9 +114,11 @@
% Find the procedure with declared argmodes which match the ones we want.
% If there was no mode declaration, then use the inferred argmodes.
+ % Allow for a renaming between the inst vars.
%
-:- pred get_procedure_matching_declmodes(assoc_list(proc_id, proc_info)::in,
- list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
+:- pred get_procedure_matching_declmodes_with_renaming(
+ assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
+ module_info::in, proc_id::out) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -373,8 +375,8 @@
pred_info_get_procedures(PredInfo, Procs),
map.to_assoc_list(Procs, ExistingProcs),
(
- get_procedure_matching_declmodes(ExistingProcs, Modes,
- !.ModuleInfo, ProcId)
+ get_procedure_matching_declmodes_with_renaming(ExistingProcs,
+ Modes, !.ModuleInfo, ProcId)
->
map.lookup(Procs, ProcId, ProcInfo),
proc_info_get_declared_determinism(ProcInfo, MaybeDet),
@@ -1133,8 +1135,8 @@
pred_info_get_procedures(PredInfo0, ProcTable0),
map.to_assoc_list(ProcTable0, ProcList),
(
- get_procedure_matching_declmodes(ProcList, ModeList,
- !.ModuleInfo, ProcId)
+ get_procedure_matching_declmodes_with_renaming(ProcList,
+ ModeList, !.ModuleInfo, ProcId)
->
map.lookup(ProcTable0, ProcId, ProcInfo0),
add_context_to_constr_termination_info(
@@ -1204,8 +1206,8 @@
pred_info_get_procedures(PredInfo0, ProcTable0),
map.to_assoc_list(ProcTable0, ProcList),
(
- get_procedure_matching_declmodes(ProcList, ModeList,
- !.ModuleInfo, ProcId)
+ get_procedure_matching_declmodes_with_renaming(ProcList,
+ ModeList, !.ModuleInfo, ProcId)
->
map.lookup(ProcTable0, ProcId, ProcInfo0),
proc_info_set_imported_structure_sharing(HeadVars, Types,
@@ -1259,8 +1261,8 @@
pred_info_get_procedures(PredInfo0, ProcTable0),
map.to_assoc_list(ProcTable0, ProcList),
(
- get_procedure_matching_declmodes(ProcList, ModeList,
- !.ModuleInfo, ProcId)
+ get_procedure_matching_declmodes_with_renaming(ProcList,
+ ModeList, !.ModuleInfo, ProcId)
->
map.lookup(ProcTable0, ProcId, ProcInfo0),
proc_info_set_imported_structure_reuse(HeadVars, Types,
@@ -1313,8 +1315,8 @@
pred_info_get_procedures(PredInfo0, ProcTable0),
map.to_assoc_list(ProcTable0, ProcList),
(
- get_procedure_matching_declmodes(ProcList, ModeList,
- !.ModuleInfo, ProcId)
+ get_procedure_matching_declmodes_with_renaming(ProcList,
+ ModeList, !.ModuleInfo, ProcId)
->
add_context_to_arg_size_info(MaybePragmaArgSizeInfo,
Context, MaybeArgSizeInfo),
@@ -1616,7 +1618,7 @@
%
% XXX We should probably also check that each pair in
% the renaming has the same name.
- get_procedure_matching_argmodes_with_renaming(ExistingProcs,
+ get_procedure_matching_declmodes_with_renaming(ExistingProcs,
Modes, !.ModuleInfo, ProcId)
->
pred_info_clauses_info(!.PredInfo, Clauses0),
@@ -2740,62 +2742,39 @@
get_procedure_matching_argmodes_2(Procs, Modes, ModuleInfo, OurProcId)
).
- % Find the procedure with argmodes which match the ones we want but
- % allow for a renaming between the inst vars.
- %
-:- pred get_procedure_matching_argmodes_with_renaming(
- assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
- module_info::in, proc_id::out) is semidet.
+:- pred mode_list_matches(list(mer_mode)::in, list(mer_mode)::in,
+ module_info::in) is semidet.
-get_procedure_matching_argmodes_with_renaming(Procs, Modes0,
+mode_list_matches([], [], _).
+mode_list_matches([Mode1 | Modes1], [Mode2 | Modes2], ModuleInfo) :-
+ % Use mode_get_insts_semidet instead of mode_get_insts to avoid
+ % aborting if there are undefined modes.
+ mode_get_insts_semidet(ModuleInfo, Mode1, Inst1, Inst2),
+ mode_get_insts_semidet(ModuleInfo, Mode2, Inst1, Inst2),
+ mode_list_matches(Modes1, Modes2, ModuleInfo).
+
+
+get_procedure_matching_declmodes_with_renaming(Procs, Modes0,
ModuleInfo, ProcId) :-
list.map(constrain_inst_vars_in_mode, Modes0, Modes),
- get_procedure_matching_argmodes_with_renaming_2(Procs, Modes,
+ get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
ModuleInfo, ProcId).
-:- pred get_procedure_matching_argmodes_with_renaming_2(
+:- pred get_procedure_matching_declmodes_with_renaming_2(
assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
module_info::in, proc_id::out) is semidet.
-get_procedure_matching_argmodes_with_renaming_2([P | Procs], Modes,
+get_procedure_matching_declmodes_with_renaming_2([P | Procs], Modes,
ModuleInfo, OurProcId) :-
P = ProcId - ProcInfo,
- proc_info_get_argmodes(ProcInfo, ArgModes),
+ proc_info_declared_argmodes(ProcInfo, ArgModes),
( mode_list_matches_with_renaming(Modes, ArgModes, ModuleInfo) ->
OurProcId = ProcId
;
- get_procedure_matching_argmodes_with_renaming_2(Procs, Modes,
+ get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
ModuleInfo, OurProcId)
).
-get_procedure_matching_declmodes(Procs, Modes0, ModuleInfo, ProcId) :-
- list.map(constrain_inst_vars_in_mode, Modes0, Modes),
- get_procedure_matching_declmodes_2(Procs, Modes, ModuleInfo, ProcId).
-
-:- pred get_procedure_matching_declmodes_2(assoc_list(proc_id, proc_info)::in,
- list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
-
-get_procedure_matching_declmodes_2([P | Procs], Modes, ModuleInfo,
- OurProcId) :-
- P = ProcId - ProcInfo,
- proc_info_declared_argmodes(ProcInfo, ArgModes),
- ( mode_list_matches(Modes, ArgModes, ModuleInfo) ->
- OurProcId = ProcId
- ;
- get_procedure_matching_declmodes_2(Procs, Modes, ModuleInfo, OurProcId)
- ).
-
-:- pred mode_list_matches(list(mer_mode)::in, list(mer_mode)::in,
- module_info::in) is semidet.
-
-mode_list_matches([], [], _).
-mode_list_matches([Mode1 | Modes1], [Mode2 | Modes2], ModuleInfo) :-
- % Use mode_get_insts_semidet instead of mode_get_insts to avoid
- % aborting if there are undefined modes.
- mode_get_insts_semidet(ModuleInfo, Mode1, Inst1, Inst2),
- mode_get_insts_semidet(ModuleInfo, Mode2, Inst1, Inst2),
- mode_list_matches(Modes1, Modes2, ModuleInfo).
-
%----------------------------------------------------------------------------%
:- type inst_var_renaming == map(inst_var, inst_var).
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.178
diff -u -r1.178 Mmakefile
--- tests/valid/Mmakefile 4 Aug 2006 10:51:22 -0000 1.178
+++ tests/valid/Mmakefile 19 Sep 2006 03:46:38 -0000
@@ -163,6 +163,7 @@
no_warn_obsolete \
nondet_live \
overloading \
+ param_mode_bug \
parsing_bug_main \
pred_with_no_modes \
qualified_cons_id \
Index: tests/valid/param_mode_bug.m
===================================================================
RCS file: tests/valid/param_mode_bug.m
diff -N tests/valid/param_mode_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/param_mode_bug.m 21 Sep 2006 07:56:58 -0000
@@ -0,0 +1,38 @@
+% rotd-2006-09-18 and before would not compile the following because
+% the fact that the inst varsets attached to the clauses and the mode
+% declarations are different meant that it couldn't work out which mode
+% belonged to which clause. The fix is to allow for a renaming between
+% inst variables.
+%
+% A similar thing occurs with the inst varset attached to foreign_export
+% pragmas.
+%
+:- module param_mode_bug.
+:- interface.
+
+:- type list(T) ---> [] ; [ T | list(T) ].
+
+:- pred foo(list(T), list(T)).
+:- mode foo(in(I), out(I)) is det.
+:- mode foo(out(I), in(I)) is det.
+
+:- pred bar(list(T)::in(I), list(T)::out(I)) is det.
+
+:- implementation.
+
+:- pragma promise_equivalent_clauses(foo/2).
+
+foo(X::in(I), X::out(I)).
+foo(Y::out(I), X::in(I)) :-
+ foo_2(Y, X).
+
+:- pred foo_2(list(T)::out(I), list(T)::in(I)) is det.
+:- pragma foreign_proc("C",
+ foo_2(Y::out(I), X::in(I)),
+ [promise_pure, thread_safe, will_not_call_mercury],
+"
+ Y = X;
+").
+
+:- pragma foreign_export("C", bar(in(I), out(I)), "BAR").
+bar(X, X).
--------------------------------------------------------------------------
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