[m-rev.] for review: fix bug with polymorphic modes and intermodule optimization
Julien Fischer
juliensf at cs.mu.OZ.AU
Mon Nov 7 15:13:27 AEDT 2005
For review by Mark.
Estimated hours taken: 16
Branches: main
Fix the problem that has been causing hard_coded/intermod_poly_mode to fail.
When writing foreign_procs to .opt files, make sure that any inst variables
have the correct name.
compiler/add_pragma.m:
When searching for the predmode decl corresponding to a foreign_proc
allow for a renaming between inst variables. If we don't do this,
then the compiler cannot find the corresponding predmode declaration
for opt_imported foreign_procs that have polymorphically moded
arguments. (The reason this is occurring is a bit obscure, it it
looks like the inst_vars in the predmode decl and those in the
foreign_proc are being allocated from different inst_varsets. Tracing
this through in the debugger indicates that this happening quite early
on, it may be that we've never made the necessary connection between
the sets of inst variables and we've never used polymorphically moded
procedures extensively enough to notice.)
compiler/mercury_to_mercury.m:
Fix an old XXX. Pass the inst_varset to the procedure that writes out
foreign_procs. This allows us to give inst variables in foreign_proc
arguments lists their correct names.
Use unexpected/2 in place of error/1.
compiler/intermod.m:
Pass the inst_varset to the procedure that writes foreign_procs in the
.opt files, so that any inst variables have the correct name.
Use unexpected/2 in place of error/1.
Julien.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.16
diff -u -r1.16 add_pragma.m
--- compiler/add_pragma.m 4 Nov 2005 03:40:42 -0000 1.16
+++ compiler/add_pragma.m 7 Nov 2005 04:03:27 -0000
@@ -1372,8 +1372,14 @@
map__to_assoc_list(Procs, ExistingProcs),
pragma_get_modes(PVars, Modes),
(
- get_procedure_matching_argmodes(ExistingProcs, Modes,
- !.ModuleInfo, ProcId)
+ % XXX We need to allow for a renaming between inst variables
+ % here, otherwise we won't find a match for opt_imported
+ % foreign_procs that have polymorphically moded arguments.
+ % This occurs because the inst vars in the foreign_proc
+ % and the corresponding mode declaration seem to be allocated
+ % from different inst_varsets.
+ get_procedure_matching_argmodes_with_renaming(ExistingProcs,
+ Modes, !.ModuleInfo, ProcId)
->
pred_info_clauses_info(!.PredInfo, Clauses0),
pred_info_arg_types(!.PredInfo, ArgTypes),
@@ -2096,6 +2102,34 @@
;
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.
+
+get_procedure_matching_argmodes_with_renaming(Procs, Modes0,
+ ModuleInfo, ProcId) :-
+ list__map(constrain_inst_vars_in_mode, Modes0, Modes),
+ get_procedure_matching_argmodes_with_renaming_2(Procs, Modes,
+ ModuleInfo, ProcId).
+
+:- pred get_procedure_matching_argmodes_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,
+ ModuleInfo, OurProcId) :-
+ P = ProcId - ProcInfo,
+ proc_info_argmodes(ProcInfo, ArgModes),
+ ( mode_list_matches_with_renaming(Modes, ArgModes, ModuleInfo) ->
+ OurProcId = ProcId
+ ;
+ get_procedure_matching_argmodes_with_renaming_2(Procs, Modes,
+ ModuleInfo, OurProcId)
+ ).
get_procedure_matching_declmodes(Procs, Modes0, ModuleInfo, ProcId) :-
list__map(constrain_inst_vars_in_mode, Modes0, Modes),
@@ -2127,6 +2161,178 @@
%----------------------------------------------------------------------------%
+:- type inst_var_renaming == map(inst_var, inst_var).
+:- type inst_var_renamings == list(inst_var_renaming).
+
+ % Succeeds if two lists of modes match allowing for a renaming
+ % of inst variables between the two lists.
+ %
+:- pred mode_list_matches_with_renaming(list(mer_mode)::in,
+ list(mer_mode)::in, module_info::in) is semidet.
+
+mode_list_matches_with_renaming(ModesA, ModesB, ModuleInfo) :-
+ mode_list_matches_with_renaming(ModesA, ModesB, _, ModuleInfo).
+
+:- pred mode_list_matches_with_renaming(list(mer_mode)::in,
+ list(mer_mode)::in, inst_var_renaming::out, module_info::in)
+ is semidet.
+
+mode_list_matches_with_renaming(ModesA, ModesB, Renaming, ModuleInfo) :-
+ mode_list_matches_with_renaming_2(ModesA, ModesB, [], Renamings,
+ ModuleInfo),
+ list.foldl(merge_inst_var_renamings, Renamings, map.init, Renaming).
+
+:- pred mode_list_matches_with_renaming_2(
+ list(mer_mode)::in, list(mer_mode)::in,
+ inst_var_renamings::in, inst_var_renamings::out,
+ module_info::in) is semidet.
+
+ mode_list_matches_with_renaming_2([], [], !Renaming, _).
+ mode_list_matches_with_renaming_2([ModeA | ModesA], [ModeB | ModesB],
+ !Substs, ModuleInfo) :-
+ %
+ % We use mode_get_insts_semidet instead of mode_get_insts to avoid
+ % aborting if there are undefined modes. (Undefined modes get
+ % reported later).
+ %
+ mode_get_insts_semidet(ModuleInfo, ModeA, InstAInitial, InstAFinal),
+ mode_get_insts_semidet(ModuleInfo, ModeB, InstBInitial, InstBFinal),
+ match_insts_with_renaming(ModuleInfo, InstAInitial, InstBInitial,
+ InitialSubst),
+ match_insts_with_renaming(ModuleInfo, InstAFinal, InstBFinal,
+ FinalSubst),
+ list.append([InitialSubst, FinalSubst], !Substs),
+ mode_list_matches_with_renaming_2(ModesA, ModesB, !Substs, ModuleInfo).
+
+:- pred match_corresponding_inst_lists_with_renaming(module_info::in,
+ list(mer_inst)::in, list(mer_inst)::in,
+ inst_var_renaming::in, inst_var_renaming::out) is semidet.
+
+match_corresponding_inst_lists_with_renaming(_, [], [], !Renaming).
+match_corresponding_inst_lists_with_renaming(ModuleInfo,
+ [ A | As ], [ B | Bs ], !Renaming) :-
+ match_insts_with_renaming(ModuleInfo, A, B, Renaming0),
+ merge_inst_var_renamings(Renaming0, !Renaming),
+ match_corresponding_inst_lists_with_renaming(ModuleInfo, As, Bs,
+ !Renaming).
+
+:- pred match_corresponding_bound_inst_lists_with_renaming(module_info::in,
+ list(bound_inst)::in, list(bound_inst)::in,
+ inst_var_renaming::in,inst_var_renaming::out) is semidet.
+
+match_corresponding_bound_inst_lists_with_renaming(_, [], [], !Renaming).
+match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
+ [A | As ], [B | Bs], !Renaming) :-
+ A = functor(ConsId, ArgsA),
+ B = functor(ConsId, ArgsB),
+ match_corresponding_inst_lists_with_renaming(ModuleInfo, ArgsA, ArgsB,
+ map.init, Renaming0),
+ merge_inst_var_renamings(Renaming0, !Renaming),
+ match_corresponding_bound_inst_lists_with_renaming(ModuleInfo, As, Bs,
+ !Renaming).
+
+:- pred match_insts_with_renaming(module_info::in, mer_inst::in, mer_inst::in,
+ map(inst_var, inst_var)::out) is semidet.
+
+match_insts_with_renaming(_, any(Uniq), any(Uniq), map.init).
+match_insts_with_renaming(_, free, free, map.init).
+match_insts_with_renaming(_, free(Type), free(Type), map.init).
+match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ InstA = bound(Uniq, BoundInstsA),
+ InstB = bound(Uniq, BoundInstsB),
+ match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
+ BoundInstsA, BoundInstsB, map.init, Renaming).
+match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ InstA = ground(Uniq, GroundInstInfoA),
+ InstB = ground(Uniq, GroundInstInfoB),
+ (
+ GroundInstInfoA = none,
+ GroundInstInfoB = none,
+ Renaming = map.init
+ ;
+ GroundInstInfoA = higher_order(PredInstInfoA),
+ GroundInstInfoB = higher_order(PredInstInfoB),
+ PredInstInfoA = pred_inst_info(PredOrFunc, ModesA, Det),
+ PredInstInfoB = pred_inst_info(PredOrFunc, ModesB, Det),
+ mode_list_matches_with_renaming(ModesA, ModesB, Renaming, ModuleInfo)
+ ).
+match_insts_with_renaming(_, not_reached, not_reached, map.init).
+match_insts_with_renaming(_, inst_var(VarA), inst_var(VarB), Subst) :-
+ svmap.insert(VarA, VarB, map.init, Subst).
+match_insts_with_renaming(ModuleInfo, InstA, InstB, Subst) :-
+ InstA = constrained_inst_vars(InstVarSetA, SpecInstA),
+ InstB = constrained_inst_vars(InstVarSetB, SpecInstB),
+ %
+ % We'll deal with the specified inst first.
+ %
+ match_insts_with_renaming(ModuleInfo, SpecInstA, SpecInstB,
+ Subst0),
+ ListVarA = set.to_sorted_list(InstVarSetA),
+ ListVarB = set.to_sorted_list(InstVarSetB),
+ (
+ ListVarA = [VarA0], ListVarB = [VarB0]
+ ->
+ VarA = VarA0,
+ VarB = VarB0
+ ;
+ unexpected(this_file,
+ "match_inst_with_renaming: non-singleton sets")
+ ),
+ ( map.search(Subst0, VarA, SpecVarB) ->
+ % If VarA was already in the renaming then check that it's consistent
+ % with the renaming from the set of inst vars.
+ VarB = SpecVarB,
+ Subst = Subst0
+ ;
+ map.insert(Subst0, VarA, VarB, Subst)
+ ).
+match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ InstA = defined_inst(InstNameA),
+ InstB = defined_inst(InstNameB),
+ match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB, Renaming).
+match_insts_with_renaming(ModuleInfo, InstA, InstB, Renaming) :-
+ InstA = abstract_inst(Name, ArgsA),
+ InstB = abstract_inst(Name, ArgsB),
+ match_corresponding_inst_lists_with_renaming(ModuleInfo, ArgsA, ArgsB,
+ map.init, Renaming).
+
+:- pred match_inst_names_with_renaming(module_info::in,
+ inst_name::in, inst_name::in, inst_var_renaming::out) is semidet.
+
+match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB, Renaming) :-
+ InstNameA = user_inst(Name, ArgsA),
+ InstNameB = user_inst(Name, ArgsB),
+ match_corresponding_inst_lists_with_renaming(ModuleInfo,
+ ArgsA, ArgsB, map.init, Renaming).
+%
+% XXX The rest of these are introduced by the compiler, it doesn't
+% look like they need any special treatment.
+%
+match_inst_names_with_renaming(_, Inst @ merge_inst(_, _), Inst, map.init).
+match_inst_names_with_renaming(_, Inst @ unify_inst(_, _, _, _), Inst,
+ map.init).
+match_inst_names_with_renaming(_, Inst @ ground_inst(_, _, _, _), Inst,
+ map.init).
+match_inst_names_with_renaming(_, Inst @ any_inst(_, _, _, _), Inst,
+ map.init).
+match_inst_names_with_renaming(_, Inst @ shared_inst(_), Inst, map.init).
+match_inst_names_with_renaming(_, Inst @ mostly_uniq_inst(_), Inst, map.init).
+match_inst_names_with_renaming(_, Inst @ typed_ground(_, _), Inst, map.init).
+match_inst_names_with_renaming(_, Inst @ typed_inst(_, _), Inst, map.init).
+
+:- pred merge_inst_var_renamings(inst_var_renaming::in,
+ inst_var_renaming::in, inst_var_renaming::out) is semidet.
+
+merge_inst_var_renamings(RenamingA, RenamingB, Result) :-
+ map.union(merge_common_inst_vars, RenamingA, RenamingB, Result).
+
+:- pred merge_common_inst_vars(inst_var::in, inst_var::in, inst_var::out)
+ is semidet.
+
+merge_common_inst_vars(A, A, A).
+
+%----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "add_pragma.m".
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.184
diff -u -r1.184 intermod.m
--- compiler/intermod.m 4 Nov 2005 03:40:48 -0000 1.184
+++ compiler/intermod.m 7 Nov 2005 03:06:10 -0000
@@ -106,6 +106,7 @@
:- import_module hlds.instmap.
:- import_module hlds.passes_aux.
:- import_module hlds.special_pred.
+:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
@@ -235,11 +236,6 @@
TypeSpecInfo = type_spec_info(_, TypeSpecForcePreds, _, _),
pred_info_clauses_info(PredInfo0, ClausesInfo0),
(
- %
- % XXX hlds_out__write_clause needs to be changed to
- % output explicit type qualifications to avoid type
- % ambiguity errors in clauses written to `.opt' files.
- %
clauses_info_explicit_vartypes(ClausesInfo0, ExplicitVarTypes),
map__is_empty(ExplicitVarTypes),
should_be_processed(ProcessLocalPreds, PredId, PredInfo0,
@@ -516,9 +512,9 @@
% non-exported types, so we just write out the clauses.
traverse_goal(Goal @ foreign_proc(_, _, _, _, _, _) - Info,
Goal - Info, yes, !Info).
-traverse_goal(shorthand(_) - _, _, _, !Info) :-
+traverse_goal(shorthand(_) - _, _, _, _, _) :-
% These should have been expanded out by now.
- error("traverse_goal: unexpected shorthand").
+ unexpected(this_file, "traverse_goal: unexpected shorthand").
:- pred traverse_list_of_goals(hlds_goals::in, hlds_goals::out,
bool::out, intermod_info::in, intermod_info::out) is det.
@@ -684,7 +680,7 @@
set__insert(Modules0, PredModule, Modules),
intermod_info_set_modules(Modules, !Info)
;
- error("add_proc: unexpected status")
+ unexpected(this_file, "add_proc: unexpected status")
).
% Resolve overloading and module qualify everything in a unify_rhs.
@@ -773,7 +769,8 @@
MethodAL)
;
MaybePredProcIds = no,
- error("gather_instances_3: method pred_proc_ids not filled in")
+ unexpected(this_file,
+ "gather_instances_3: method pred_proc_ids not filled in")
),
list__map_foldl(qualify_instance_method(ModuleInfo),
MethodAL, Methods, [], PredIds),
@@ -945,7 +942,7 @@
unqualify_name(InstanceMethodName0, UnqualMethodName),
InstanceMethodName = qualified(TypeModule, UnqualMethodName)
;
- error("unqualified type_ctor in " ++
+ unexpected(this_file, "unqualified type_ctor in " ++
"hlds_cons_defn or hlds_ctor_field_defn")
)
).
@@ -1505,7 +1502,8 @@
ArgModes = ArgModes0,
Detism = Detism0
;
- error("write_pred_modes: attempt to write undeclared mode")
+ unexpected(this_file,
+ "write_pred_modes: attempt to write undeclared mode")
),
proc_info_context(ProcInfo, Context),
varset__init(Varset),
@@ -1546,7 +1544,8 @@
hlds_out__write_promise(PromiseType, 0, ModuleInfo,
PredId, VarSet, no, HeadVars, PredOrFunc, Clause, no, !IO)
;
- error("write_preds: assertion not a single clause.")
+ unexpected(this_file,
+ "write_preds: assertion not a single clause.")
)
;
pred_info_typevarset(PredInfo, TypeVarset),
@@ -1594,7 +1593,7 @@
list__foldl(write_foreign_clause(Procs, PredOrFunc,
PragmaCode, Attributes, Args, VarSet, SymName), ProcIds, !IO)
;
- error("foreign_proc expected within this goal")
+ unexpected(this_file, "foreign_proc expected within this goal")
).
:- pred write_foreign_clause(proc_table::in, pred_or_func::in,
@@ -1603,16 +1602,20 @@
io::di, io::uo) is det.
write_foreign_clause(Procs, PredOrFunc, PragmaImpl,
- Attributes, Args, VarSet0, SymName, ProcId, !IO) :-
+ Attributes, Args, ProgVarset0, SymName, ProcId, !IO) :-
map__lookup(Procs, ProcId, ProcInfo),
proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
- ( MaybeArgModes = yes(ArgModes) ->
- get_pragma_foreign_code_vars(Args, ArgModes, VarSet0, VarSet,
- PragmaVars),
+ (
+ MaybeArgModes = yes(ArgModes),
+ get_pragma_foreign_code_vars(Args, ArgModes,
+ ProgVarset0, ProgVarset, PragmaVars),
+ proc_info_inst_varset(ProcInfo, InstVarset),
mercury_output_pragma_foreign_code(Attributes, SymName,
- PredOrFunc, PragmaVars, VarSet, PragmaImpl, !IO)
+ PredOrFunc, PragmaVars, ProgVarset, InstVarset, PragmaImpl,
+ !IO)
;
- error("write_clause: no mode declaration")
+ MaybeArgModes = no,
+ unexpected(this_file, "write_clause: no mode declaration")
).
% Strip the `Headvar__n = Term' unifications from each clause,
@@ -1747,7 +1750,7 @@
AppendVarnums = yes,
mercury_output_pragma_type_spec(Pragma, AppendVarnums, !IO)
;
- error("write_type_spec_pragma")
+ unexpected(this_file, "write_type_spec_pragma")
).
% Is a pragma declaration required in the `.opt' file for
@@ -1790,7 +1793,7 @@
should_output_marker(check_termination, no).
should_output_marker(generate_inline, _) :-
% This marker should only occur after the magic sets transformation.
- error("should_output_marker: generate_inline").
+ unexpected(this_file, "should_output_marker: generate_inline").
should_output_marker(calls_are_fully_qualified, no).
should_output_marker(mode_check_clauses, yes).
@@ -1820,7 +1823,7 @@
->
PragmaVars = []
;
- error("intermod:get_pragma_foreign_code_vars")
+ unexpected(this_file, "get_pragma_foreign_code_vars")
).
%-----------------------------------------------------------------------------%
@@ -2316,3 +2319,11 @@
).
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "intermod.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module intermod.
+%-----------------------------------------------------------------------------%
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.272
diff -u -r1.272 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 28 Oct 2005 02:10:18 -0000 1.272
+++ compiler/mercury_to_mercury.m 7 Nov 2005 04:02:15 -0000
@@ -136,9 +136,10 @@
:- pred mercury_output_pragma_foreign_code(pragma_foreign_proc_attributes::in,
sym_name::in, pred_or_func::in, list(pragma_var)::in, prog_varset::in,
- pragma_foreign_code_impl::in, io::di, io::uo) is det.
+ inst_varset::in, pragma_foreign_code_impl::in, io::di, io::uo)
+ is det.
:- func mercury_pragma_foreign_code_to_string(pragma_foreign_proc_attributes,
- sym_name, pred_or_func, list(pragma_var), prog_varset,
+ sym_name, pred_or_func, list(pragma_var), prog_varset, inst_varset,
pragma_foreign_code_impl) = string.
:- inst type_spec == bound(type_spec(ground, ground, ground, ground,
@@ -373,6 +374,7 @@
:- implementation.
+:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module libs.rat.
@@ -436,8 +438,8 @@
%-----------------------------------------------------------------------------%
- % output the declarations one by one
-
+ % Output the declarations one by one.
+ %
:- pred mercury_output_item_list(bool::in, list(item_and_context)::in,
io::di, io::uo) is det.
@@ -558,8 +560,10 @@
;
Pragma = foreign_proc(Attributes, Pred, PredOrFunc, Vars, VarSet,
PragmaCode),
+ % The inst_varset isn't available to us here.
+ InstVarset = varset.init,
mercury_output_pragma_foreign_code(Attributes, Pred,
- PredOrFunc, Vars, VarSet, PragmaCode, !IO)
+ PredOrFunc, Vars, VarSet, InstVarset, PragmaCode, !IO)
;
Pragma = import(Pred, PredOrFunc, ModeList, Attributes, C_Function),
mercury_format_pragma_import(Pred, PredOrFunc, ModeList,
@@ -900,7 +904,7 @@
Body, Context, !IO)
)
;
- error("invalid instance method item")
+ unexpected(this_file, "invalid instance method item")
).
%-----------------------------------------------------------------------------%
@@ -3027,22 +3031,24 @@
%-----------------------------------------------------------------------------%
mercury_output_pragma_foreign_code(Attributes, PredName, PredOrFunc, Vars0,
- VarSet, PragmaCode, !IO) :-
+ ProgVarset, InstVarset, PragmaCode, !IO) :-
mercury_format_pragma_foreign_code(Attributes, PredName, PredOrFunc,
- Vars0, VarSet, PragmaCode, !IO).
+ Vars0, ProgVarset, InstVarset, PragmaCode, !IO).
mercury_pragma_foreign_code_to_string(Attributes, PredName, PredOrFunc, Vars0,
- VarSet, PragmaCode) = String :-
+ ProgVarset, InstVarset, PragmaCode) = String :-
mercury_format_pragma_foreign_code(Attributes, PredName, PredOrFunc,
- Vars0, VarSet, PragmaCode, "", String).
+ Vars0, ProgVarset, InstVarset, PragmaCode, "", String).
+ % Output the given pragma foreign_code declaration.
+ %
:- pred mercury_format_pragma_foreign_code(pragma_foreign_proc_attributes::in,
sym_name::in, pred_or_func::in, list(pragma_var)::in, prog_varset::in,
- pragma_foreign_code_impl::in, U::di, U::uo) is det <= output(U).
+ inst_varset::in, pragma_foreign_code_impl::in,
+ U::di, U::uo) is det <= output(U).
- % Output the given pragma foreign_code declaration
mercury_format_pragma_foreign_code(Attributes, PredName, PredOrFunc, Vars0,
- VarSet, PragmaCode, !U) :-
+ ProgVarset, InstVarset, PragmaCode, !U) :-
(
PragmaCode = import(C_Function, _, _, _),
% The predicate or function arguments in a `:- pragma import'
@@ -3055,20 +3061,20 @@
;
PragmaCode = ordinary(_, _),
mercury_format_pragma_foreign_code_2(Attributes, PredName,
- PredOrFunc, Vars0, VarSet, PragmaCode, !U)
+ PredOrFunc, Vars0, ProgVarset, InstVarset, PragmaCode, !U)
;
PragmaCode = nondet(_, _, _, _, _, _, _, _, _),
mercury_format_pragma_foreign_code_2(Attributes, PredName,
- PredOrFunc, Vars0, VarSet, PragmaCode, !U)
+ PredOrFunc, Vars0, ProgVarset, InstVarset, PragmaCode, !U)
).
:- pred mercury_format_pragma_foreign_code_2(
pragma_foreign_proc_attributes::in, sym_name::in, pred_or_func::in,
- list(pragma_var)::in, prog_varset::in, pragma_foreign_code_impl::in,
- U::di, U::uo) is det <= output(U).
+ list(pragma_var)::in, prog_varset::in, inst_varset::in,
+ pragma_foreign_code_impl::in, U::di, U::uo) is det <= output(U).
mercury_format_pragma_foreign_code_2(Attributes, PredName, PredOrFunc, Vars0,
- VarSet, PragmaCode, !U) :-
+ ProgVarset, InstVarset, PragmaCode, !U) :-
add_string(":- pragma foreign_proc(", !U),
Lang = foreign_language(Attributes),
mercury_format_foreign_language_string(Lang, !U),
@@ -3088,7 +3094,8 @@
;
Vars = [_ | _],
add_string("(", !U),
- mercury_format_pragma_foreign_code_vars(Vars, VarSet, !U),
+ mercury_format_pragma_foreign_code_vars(Vars, ProgVarset,
+ InstVarset, !U),
add_string(")", !U)
),
(
@@ -3096,7 +3103,8 @@
;
PredOrFunc = function,
add_string(" = (", !U),
- mercury_format_pragma_foreign_code_vars(ResultVars, VarSet, !U),
+ mercury_format_pragma_foreign_code_vars(ResultVars, ProgVarset,
+ InstVarset, !U),
add_string(")", !U)
),
add_string(", ", !U),
@@ -3131,31 +3139,41 @@
;
PragmaCode = import(_, _, _, _),
% This should be handle in mercury_output_pragma_foreign_code.
- error("mercury_output_pragma_foreign_code_2")
+ unexpected(this_file, "mercury_output_pragma_foreign_code_2")
),
add_string(").\n", !U).
%-----------------------------------------------------------------------------%
- % Output the varnames of the pragma vars
+ % Output the varnames of the pragma vars.
+ %
:- pred mercury_format_pragma_foreign_code_vars(list(pragma_var)::in,
- prog_varset::in, U::di, U::uo) is det <= output(U).
+ prog_varset::in, inst_varset::in, U::di, U::uo)
+ is det <= output(U).
+
+mercury_format_pragma_foreign_code_vars(Vars, ProgVarset, InstVarset, !U) :-
+ mercury_format_pragma_foreign_code_vars_2(Vars, ProgVarset, InstVarset,
+ !U).
-mercury_format_pragma_foreign_code_vars([], _, !U).
-mercury_format_pragma_foreign_code_vars([Var | Vars], VarSet, !U) :-
+:- pred mercury_format_pragma_foreign_code_vars_2(list(pragma_var)::in,
+ prog_varset::in, inst_varset::in, U::di, U::uo)
+ is det <= output(U).
+
+mercury_format_pragma_foreign_code_vars_2([], _, _, !U).
+mercury_format_pragma_foreign_code_vars_2([Var | Vars], ProgVarset,
+ InstVarset, !U) :-
Var = pragma_var(_Var, VarName, Mode),
add_string(VarName, !U),
add_string(" :: ", !U),
- % XXX Fake the inst varset
- varset__init(InstVarSet),
- mercury_format_mode(Mode, simple_inst_info(InstVarSet), !U),
+ mercury_format_mode(Mode, simple_inst_info(InstVarset), !U),
(
Vars = []
;
Vars = [_ | _],
add_string(", ", !U)
),
- mercury_format_pragma_foreign_code_vars(Vars, VarSet, !U).
+ mercury_format_pragma_foreign_code_vars_2(Vars, ProgVarset, InstVarset,
+ !U).
%-----------------------------------------------------------------------------%
@@ -3170,7 +3188,7 @@
PredOrFunc = PredOrFunc0
;
MaybePredOrFunc = no,
- error("pragma type_spec: no pred_or_func")
+ unexpected(this_file, "pragma type_spec: no pred_or_func")
),
(
PredOrFunc = function,
--------------------------------------------------------------------------
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