[m-rev.] diff: move some predicates
Zoltan Somogyi
zs at unimelb.edu.au
Fri Sep 7 21:39:46 AEST 2012
Move some predicates to the modules where they belong. There are no
algorithmic changes.
compiler/add_pragma.m:
compiler/hlds_code_util.m:
Move some predicates from add_pragma.m to hlds_code_util.m;
they are used not only when adding pragmas.
compiler/prog_io.m:
compiler/prog_mode.m:
Move some predicates from prog_io.m to prog_mode.m;
they do not do parsing.
compiler/add_clause.m:
compiler/prog_io_pragma.m:
Conform to the changes above.
compiler/hlds.m:
Fix typos.
Zoltan.
cvs diff: Diffing .
Index: add_pragma.m
--- /home/zs/ws/ws00/compiler/add_pragma.m 2012-09-06 17:58:36.532637975 +1000
+++ add_pragma.m 2012-09-07 19:50:53.696771881 +1000
@@ -18,7 +18,6 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_item.
-:- import_module assoc_list.
:- import_module list.
:- import_module maybe.
:- import_module term.
@@ -93,14 +92,6 @@
:- func lookup_current_backend(globals) = backend.
- % 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_with_renaming(
- assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
- module_info::in, proc_id::out) is semidet.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -139,7 +130,6 @@
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_ctgc.
:- import_module parse_tree.prog_foreign.
-:- import_module parse_tree.prog_io.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
@@ -151,6 +141,7 @@
:- import_module transform_hlds.term_constr_util.
:- import_module transform_hlds.term_util.
+:- import_module assoc_list.
:- import_module bag.
:- import_module bimap.
:- import_module bool.
@@ -3507,257 +3498,9 @@
)
).
- % Find the procedure with argmodes which match the ones we want.
- %
-:- pred get_procedure_matching_argmodes(assoc_list(proc_id, proc_info)::in,
- list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
-
-get_procedure_matching_argmodes(Procs, Modes0, ModuleInfo, ProcId) :-
- list.map(constrain_inst_vars_in_mode, Modes0, Modes),
- get_procedure_matching_argmodes_2(Procs, Modes, ModuleInfo, ProcId).
-
-:- pred get_procedure_matching_argmodes_2(assoc_list(proc_id, proc_info)::in,
- list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
-
-get_procedure_matching_argmodes_2([P | Procs], Modes, ModuleInfo, OurProcId) :-
- P = ProcId - ProcInfo,
- proc_info_get_argmodes(ProcInfo, ArgModes),
- ( mode_list_matches(Modes, ArgModes, ModuleInfo) ->
- OurProcId = ProcId
- ;
- get_procedure_matching_argmodes_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).
-
-
-get_procedure_matching_declmodes_with_renaming(Procs, Modes0,
- ModuleInfo, ProcId) :-
- list.map(constrain_inst_vars_in_mode, Modes0, Modes),
- get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
- ModuleInfo, ProcId).
-
-:- 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_declmodes_with_renaming_2([P | Procs], Modes,
- ModuleInfo, OurProcId) :-
- P = ProcId - ProcInfo,
- proc_info_declared_argmodes(ProcInfo, ArgModes),
- ( mode_list_matches_with_renaming(Modes, ArgModes, ModuleInfo) ->
- OurProcId = ProcId
- ;
- get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
- ModuleInfo, OurProcId)
- ).
-
-%----------------------------------------------------------------------------%
-
-:- 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 = bound_functor(ConsId, ArgsA),
- B = bound_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(ModuleInfo, InstA, InstB, Renaming) :-
- (
- InstA = not_reached,
- InstB = not_reached,
- map.init(Renaming)
- ;
- InstA = free,
- InstB = free,
- map.init(Renaming)
- ;
- InstA = free(Type),
- InstB = free(Type),
- map.init(Renaming)
- ;
- InstA = any(Uniq, HOInstInfoA),
- InstB = any(Uniq, HOInstInfoB),
- match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
- Renaming)
- ;
- InstA = ground(Uniq, HOInstInfoA),
- InstB = ground(Uniq, HOInstInfoB),
- match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
- Renaming)
- ;
- InstA = bound(Uniq, _, BoundInstsA),
- InstB = bound(Uniq, _, BoundInstsB),
- match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
- BoundInstsA, BoundInstsB, map.init, Renaming)
- ;
- InstA = inst_var(VarA),
- InstB = inst_var(VarB),
- Renaming = map.singleton(VarA, VarB)
- ;
- InstA = constrained_inst_vars(InstVarSetA, SpecInstA),
- InstB = constrained_inst_vars(InstVarSetB, SpecInstB),
-
- % We will deal with the specified inst first.
- match_insts_with_renaming(ModuleInfo, SpecInstA, SpecInstB, Renaming0),
- ListVarA = set.to_sorted_list(InstVarSetA),
- ListVarB = set.to_sorted_list(InstVarSetB),
- (
- ListVarA = [VarA0],
- ListVarB = [VarB0]
- ->
- VarA = VarA0,
- VarB = VarB0
- ;
- unexpected($module, $pred, "non-singleton sets")
- ),
- ( map.search(Renaming0, VarA, SpecVarB) ->
- % If VarA was already in the renaming then check that it is
- % consistent with the renaming from the set of inst vars.
- VarB = SpecVarB,
- Renaming = Renaming0
- ;
- map.insert(VarA, VarB, Renaming0, Renaming)
- )
- ;
- InstA = defined_inst(InstNameA),
- InstB = defined_inst(InstNameB),
- match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB,
- 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_ho_inst_infos_with_renaming(module_info::in, ho_inst_info::in,
- ho_inst_info::in, map(inst_var, inst_var)::out) is semidet.
-
-match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
- Renaming) :-
- (
- HOInstInfoA = none,
- HOInstInfoB = none,
- Renaming = map.init
- ;
- HOInstInfoA = higher_order(PredInstInfoA),
- HOInstInfoB = higher_order(PredInstInfoB),
- PredInstInfoA = pred_inst_info(PredOrFunc, ModesA, _, Detism),
- PredInstInfoB = pred_inst_info(PredOrFunc, ModesB, _, Detism),
- mode_list_matches_with_renaming(ModesA, ModesB, Renaming, ModuleInfo)
- ).
-
-:- 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.
- ( InstNameA = merge_inst(_, _)
- ; InstNameA = unify_inst(_, _, _, _)
- ; InstNameA = ground_inst(_, _, _, _)
- ; InstNameA = any_inst(_, _, _, _)
- ; InstNameA = shared_inst(_)
- ; InstNameA = mostly_uniq_inst(_)
- ),
- InstNameB = InstNameA,
- Renaming = 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).
-
%----------------------------------------------------------------------------%
%
-% Code for checking required feature set pragmas
+% Code for checking required feature set pragmas.
%
:- pred check_required_feature_set(set(required_feature)::in,
Index: hlds.m
--- /home/zs/ws/ws00/compiler/hlds.m 2012-06-11 13:17:20.480275897 +1000
+++ hlds.m 2012-09-07 19:35:29.372380922 +1000
@@ -18,7 +18,7 @@
%-----------------------------------------------------------------------------%
-% The HLDS data structure itself
+% The HLDS data structure itself.
:- include_module assertion.
:- include_module const_struct.
:- include_module hlds_args.
@@ -34,7 +34,7 @@
:- include_module pred_table.
:- include_module special_pred.
-% Modules for creating the HLDS
+% Modules for creating the HLDS.
:- include_module hhf.
:- include_module make_hlds.
:- include_module make_tags.
Index: hlds_code_util.m
--- /home/zs/ws/ws00/compiler/hlds_code_util.m 2012-06-25 12:42:57.188396967 +1000
+++ hlds_code_util.m 2012-09-07 19:42:28.670139879 +1000
@@ -17,9 +17,11 @@
:- interface.
:- import_module hlds.hlds_data.
+:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_module.
:- import_module parse_tree.prog_data.
+:- import_module assoc_list.
:- import_module list.
%-----------------------------------------------------------------------------%
@@ -50,6 +52,20 @@
:- pred is_valid_mutable_inst(module_info::in, mer_inst::in) is semidet.
%-----------------------------------------------------------------------------%
+
+ % Find the procedure with argmodes which match the ones we want.
+ %
+:- pred get_procedure_matching_argmodes(assoc_list(proc_id, proc_info)::in,
+ list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
+
+ % 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_with_renaming(
+ assoc_list(proc_id, proc_info)::in, list(mer_mode)::in,
+ module_info::in, proc_id::out) is semidet.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -63,6 +79,7 @@
:- import_module char.
:- import_module map.
+:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
@@ -252,5 +269,252 @@
are_valid_mutable_insts(ModuleInfo, Insts, Expansions0).
%----------------------------------------------------------------------------%
+
+get_procedure_matching_argmodes(Procs, Modes0, ModuleInfo, ProcId) :-
+ list.map(constrain_inst_vars_in_mode, Modes0, Modes),
+ get_procedure_matching_argmodes_2(Procs, Modes, ModuleInfo, ProcId).
+
+:- pred get_procedure_matching_argmodes_2(assoc_list(proc_id, proc_info)::in,
+ list(mer_mode)::in, module_info::in, proc_id::out) is semidet.
+
+get_procedure_matching_argmodes_2([P | Procs], Modes, ModuleInfo, OurProcId) :-
+ P = ProcId - ProcInfo,
+ proc_info_get_argmodes(ProcInfo, ArgModes),
+ ( mode_list_matches(Modes, ArgModes, ModuleInfo) ->
+ OurProcId = ProcId
+ ;
+ get_procedure_matching_argmodes_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.
+ % XXX
+ 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_declmodes_with_renaming_2(Procs, Modes,
+ ModuleInfo, ProcId).
+
+:- 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_declmodes_with_renaming_2([P | Procs], Modes,
+ ModuleInfo, OurProcId) :-
+ P = ProcId - ProcInfo,
+ proc_info_declared_argmodes(ProcInfo, ArgModes),
+ ( mode_list_matches_with_renaming(Modes, ArgModes, ModuleInfo) ->
+ OurProcId = ProcId
+ ;
+ get_procedure_matching_declmodes_with_renaming_2(Procs, Modes,
+ ModuleInfo, OurProcId)
+ ).
+
+:- 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 = bound_functor(ConsId, ArgsA),
+ B = bound_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(ModuleInfo, InstA, InstB, Renaming) :-
+ (
+ InstA = not_reached,
+ InstB = not_reached,
+ map.init(Renaming)
+ ;
+ InstA = free,
+ InstB = free,
+ map.init(Renaming)
+ ;
+ InstA = free(Type),
+ InstB = free(Type),
+ map.init(Renaming)
+ ;
+ InstA = any(Uniq, HOInstInfoA),
+ InstB = any(Uniq, HOInstInfoB),
+ match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
+ Renaming)
+ ;
+ InstA = ground(Uniq, HOInstInfoA),
+ InstB = ground(Uniq, HOInstInfoB),
+ match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
+ Renaming)
+ ;
+ InstA = bound(Uniq, _, BoundInstsA),
+ InstB = bound(Uniq, _, BoundInstsB),
+ match_corresponding_bound_inst_lists_with_renaming(ModuleInfo,
+ BoundInstsA, BoundInstsB, map.init, Renaming)
+ ;
+ InstA = inst_var(VarA),
+ InstB = inst_var(VarB),
+ Renaming = map.singleton(VarA, VarB)
+ ;
+ InstA = constrained_inst_vars(InstVarSetA, SpecInstA),
+ InstB = constrained_inst_vars(InstVarSetB, SpecInstB),
+
+ % We will deal with the specified inst first.
+ match_insts_with_renaming(ModuleInfo, SpecInstA, SpecInstB, Renaming0),
+ ListVarA = set.to_sorted_list(InstVarSetA),
+ ListVarB = set.to_sorted_list(InstVarSetB),
+ (
+ ListVarA = [VarA0],
+ ListVarB = [VarB0]
+ ->
+ VarA = VarA0,
+ VarB = VarB0
+ ;
+ unexpected($module, $pred, "non-singleton sets")
+ ),
+ ( map.search(Renaming0, VarA, SpecVarB) ->
+ % If VarA was already in the renaming then check that it is
+ % consistent with the renaming from the set of inst vars.
+ VarB = SpecVarB,
+ Renaming = Renaming0
+ ;
+ map.insert(VarA, VarB, Renaming0, Renaming)
+ )
+ ;
+ InstA = defined_inst(InstNameA),
+ InstB = defined_inst(InstNameB),
+ match_inst_names_with_renaming(ModuleInfo, InstNameA, InstNameB,
+ 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_ho_inst_infos_with_renaming(module_info::in, ho_inst_info::in,
+ ho_inst_info::in, map(inst_var, inst_var)::out) is semidet.
+
+match_ho_inst_infos_with_renaming(ModuleInfo, HOInstInfoA, HOInstInfoB,
+ Renaming) :-
+ (
+ HOInstInfoA = none,
+ HOInstInfoB = none,
+ Renaming = map.init
+ ;
+ HOInstInfoA = higher_order(PredInstInfoA),
+ HOInstInfoB = higher_order(PredInstInfoB),
+ PredInstInfoA = pred_inst_info(PredOrFunc, ModesA, _, Detism),
+ PredInstInfoB = pred_inst_info(PredOrFunc, ModesB, _, Detism),
+ mode_list_matches_with_renaming(ModesA, ModesB, Renaming, ModuleInfo)
+ ).
+
+:- 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.
+ ( InstNameA = merge_inst(_, _)
+ ; InstNameA = unify_inst(_, _, _, _)
+ ; InstNameA = ground_inst(_, _, _, _)
+ ; InstNameA = any_inst(_, _, _, _)
+ ; InstNameA = shared_inst(_)
+ ; InstNameA = mostly_uniq_inst(_)
+ ),
+ InstNameB = InstNameA,
+ Renaming = 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).
+
+
+%----------------------------------------------------------------------------%
:- end_module hlds_code_util.
%----------------------------------------------------------------------------%
Index: prog_io.m
--- /home/zs/ws/ws00/compiler/prog_io.m 2012-09-06 17:58:37.042452864 +1000
+++ prog_io.m 2012-09-07 19:53:47.913516262 +1000
@@ -52,7 +52,6 @@
:- import_module libs.timestamp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
-:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_io_util.
@@ -158,33 +157,6 @@
maybe1(item)::out) is det.
%-----------------------------------------------------------------------------%
-%
-% XXX Why are these predicates in this module? Wouldn't e.g prog_mode.m
-% be more appropriate?
-%
-
- % Replace all occurrences of inst_var(InstVar) with
- % constrained_inst_var(InstVar, ground(shared, none)).
- %
-:- pred constrain_inst_vars_in_mode(mer_mode::in, mer_mode::out) is det.
-
- % Replace all occurrences of inst_var(InstVar) with
- % constrained_inst_var(InstVar, Inst) where InstVar -> Inst
- % is in the inst_var_sub.
- % If InstVar is not in the inst_var_sub, default to ground(shared, none).
- %
-:- pred constrain_inst_vars_in_mode_sub(inst_var_sub::in,
- mer_mode::in, mer_mode::out) is det.
-
-%-----------------------------------------------------------------------------%
-
- % Check that for each constrained_inst_var all occurrences have the
- % same constraint.
- %
-:- pred inst_var_constraints_are_self_consistent_in_modes(list(mer_mode)::in)
- is semidet.
-
-%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -192,6 +164,7 @@
:- import_module libs.options.
:- import_module parse_tree.file_names.
:- import_module parse_tree.mercury_to_mercury.
+:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_io_dcg.
:- import_module parse_tree.prog_io_goal.
:- import_module parse_tree.prog_io_mode_defn.
@@ -2227,227 +2200,6 @@
).
%-----------------------------------------------------------------------------%
-
-constrain_inst_vars_in_mode(Mode0, Mode) :-
- constrain_inst_vars_in_mode_sub(map.init, Mode0, Mode).
-
-constrain_inst_vars_in_mode_sub(InstConstraints, Mode0, Mode) :-
- (
- Mode0 = (I0 -> F0),
- constrain_inst_vars_in_inst(InstConstraints, I0, I),
- constrain_inst_vars_in_inst(InstConstraints, F0, F),
- Mode = (I -> F)
- ;
- Mode0 = user_defined_mode(Name, Args0),
- list.map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
- Mode = user_defined_mode(Name, Args)
- ).
-
-:- pred constrain_inst_vars_in_inst(inst_var_sub::in,
- mer_inst::in, mer_inst::out) is det.
-
-constrain_inst_vars_in_inst(InstConstraints, Inst0, Inst) :-
- (
- ( Inst0 = not_reached
- ; Inst0 = free
- ; Inst0 = free(_)
- ; Inst0 = ground(_Uniq, none)
- ; Inst0 = any(_Uniq, none)
- ),
- Inst = Inst0
- ;
- Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
- constrain_inst_vars_in_pred_inst_info(InstConstraints,
- PredInstInfo0, PredInstInfo),
- Inst = ground(Uniq, higher_order(PredInstInfo))
- ;
- Inst0 = any(Uniq, higher_order(PredInstInfo0)),
- constrain_inst_vars_in_pred_inst_info(InstConstraints,
- PredInstInfo0, PredInstInfo),
- Inst = any(Uniq, higher_order(PredInstInfo))
- ;
- Inst0 = bound(Uniq, InstResults0, BoundInsts0),
- (
- InstResults0 = inst_test_results_fgtc,
- % There are no inst_vars to substitute.
- Inst = Inst0
- ;
- ( InstResults0 = inst_test_no_results
- ; InstResults0 = inst_test_results(_, _, _, _)
- ),
- list.map(
- (pred(bound_functor(C, Is0)::in, bound_functor(C, Is)::out)
- is det :-
- list.map(constrain_inst_vars_in_inst(InstConstraints),
- Is0, Is)),
- BoundInsts0, BoundInsts),
- % The substitutions inside BoundInsts can invalidate
- % any of the existing results.
- Inst = bound(Uniq, inst_test_no_results, BoundInsts)
- )
- ;
- Inst0 = constrained_inst_vars(Vars0, SubInst0),
- constrain_inst_vars_in_inst(InstConstraints, SubInst0, SubInst1),
- ( SubInst1 = constrained_inst_vars(SubVars, SubSubInst) ->
- set.union(Vars0, SubVars, Vars),
- SubInst = SubSubInst
- ;
- Vars = Vars0,
- SubInst = SubInst1
- ),
- Inst = constrained_inst_vars(Vars, SubInst)
- ;
- Inst0 = inst_var(Var),
- ( map.search(InstConstraints, Var, SubInstPrime) ->
- SubInst = SubInstPrime
- ;
- SubInst = ground(shared, none)
- ),
- Inst = constrained_inst_vars(set.make_singleton_set(Var), SubInst)
- ;
- Inst0 = defined_inst(Name0),
- constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name),
- Inst = defined_inst(Name)
- ;
- Inst0 = abstract_inst(InstName, SubInsts0),
- list.map(constrain_inst_vars_in_inst(InstConstraints),
- SubInsts0, SubInsts),
- Inst = abstract_inst(InstName, SubInsts)
- ).
-
-:- pred constrain_inst_vars_in_pred_inst_info(inst_var_sub::in,
- pred_inst_info::in, pred_inst_info::out) is det.
-
-constrain_inst_vars_in_pred_inst_info(InstConstraints, PII0, PII) :-
- PII0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
- list.map(constrain_inst_vars_in_mode_sub(InstConstraints), Modes0, Modes),
- PII = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det).
-
-:- pred constrain_inst_vars_in_inst_name(inst_var_sub::in,
- inst_name::in, inst_name::out) is det.
-
-constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name) :-
- ( Name0 = user_inst(SymName, Args0) ->
- list.map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
- Name = user_inst(SymName, Args)
- ;
- Name = Name0
- ).
-
-%-----------------------------------------------------------------------------%
-
-inst_var_constraints_are_self_consistent_in_modes(Modes) :-
- inst_var_constraints_are_consistent_in_modes(Modes, map.init, _).
-
-:- pred inst_var_constraints_are_consistent_in_modes(list(mer_mode)::in,
- inst_var_sub::in, inst_var_sub::out) is semidet.
-
-inst_var_constraints_are_consistent_in_modes(Modes, !Sub) :-
- list.foldl(inst_var_constraints_are_consistent_in_mode, Modes, !Sub).
-
-:- pred inst_var_constraints_types_modes_self_consistent(
- list(type_and_mode)::in) is semidet.
-
-inst_var_constraints_types_modes_self_consistent(TypeAndModes) :-
- list.foldl(inst_var_constraints_type_mode_consistent, TypeAndModes,
- map.init, _).
-
-:- pred inst_var_constraints_type_mode_consistent(type_and_mode::in,
- inst_var_sub::in, inst_var_sub::out) is semidet.
-
-inst_var_constraints_type_mode_consistent(TypeAndMode, !Sub) :-
- (
- TypeAndMode = type_only(_)
- ;
- TypeAndMode = type_and_mode(_, Mode),
- inst_var_constraints_are_consistent_in_mode(Mode, !Sub)
- ).
-
-:- pred inst_var_constraints_are_consistent_in_mode(mer_mode::in,
- inst_var_sub::in, inst_var_sub::out) is semidet.
-
-inst_var_constraints_are_consistent_in_mode(Mode, !Sub) :-
- (
- Mode = (InitialInst -> FinalInst),
- inst_var_constraints_are_consistent_in_inst(InitialInst, !Sub),
- inst_var_constraints_are_consistent_in_inst(FinalInst, !Sub)
- ;
- Mode = user_defined_mode(_, ArgInsts),
- inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
- ).
-
-:- pred inst_var_constraints_are_consistent_in_insts(list(mer_inst)::in,
- inst_var_sub::in, inst_var_sub::out) is semidet.
-
-inst_var_constraints_are_consistent_in_insts(Insts, !Sub) :-
- list.foldl(inst_var_constraints_are_consistent_in_inst, Insts, !Sub).
-
-:- pred inst_var_constraints_are_consistent_in_inst(mer_inst::in,
- inst_var_sub::in, inst_var_sub::out) is semidet.
-
-inst_var_constraints_are_consistent_in_inst(Inst, !Sub) :-
- (
- ( Inst = free
- ; Inst = free(_)
- ; Inst = not_reached
- )
- ;
- Inst = bound(_, InstResults, BoundInsts),
- (
- InstResults = inst_test_results_fgtc
- ;
- ( InstResults = inst_test_no_results
- ; InstResults = inst_test_results(_, _, _, _)
- ),
- list.foldl(
- (pred(bound_functor(_, Insts)::in, in, out) is semidet -->
- inst_var_constraints_are_consistent_in_insts(Insts)
- ),
- BoundInsts, !Sub)
- )
- ;
- ( Inst = ground(_, HOInstInfo)
- ; Inst = any(_, HOInstInfo)
- ),
- (
- HOInstInfo = none
- ;
- HOInstInfo = higher_order(pred_inst_info(_, Modes, _, _)),
- inst_var_constraints_are_consistent_in_modes(Modes, !Sub)
- )
- ;
- Inst = inst_var(_),
- unexpected($module, $pred, "unconstrained inst_var")
- ;
- Inst = defined_inst(InstName),
- ( InstName = user_inst(_, ArgInsts) ->
- inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
- ;
- true
- )
- ;
- Inst = abstract_inst(_, ArgInsts),
- inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
- ;
- Inst = constrained_inst_vars(InstVars, SubInst),
- set.fold(inst_var_constraints_are_consistent_in_inst_var(SubInst),
- InstVars, !Sub),
- inst_var_constraints_are_consistent_in_inst(SubInst, !Sub)
- ).
-
-:- pred inst_var_constraints_are_consistent_in_inst_var(mer_inst::in,
- inst_var::in, inst_var_sub::in, inst_var_sub::out) is semidet.
-
-inst_var_constraints_are_consistent_in_inst_var(SubInst, InstVar, !Sub) :-
- ( map.search(!.Sub, InstVar, InstVarInst) ->
- % Check that the inst_var constraint is consistent with
- % the previous constraint on this inst_var.
- InstVarInst = SubInst
- ;
- map.det_insert(InstVar, SubInst, !Sub)
- ).
-
-%-----------------------------------------------------------------------------%
% A ModuleSpecifier is just an sym_name.
%
Index: prog_mode.m
--- /home/zs/ws/ws00/compiler/prog_mode.m 2012-04-23 16:50:00.236474154 +1000
+++ prog_mode.m 2012-09-07 19:46:28.762965575 +1000
@@ -133,6 +133,29 @@
:- pred strip_builtin_qualifiers_from_inst(mer_inst::in, mer_inst::out) is det.
%-----------------------------------------------------------------------------%
+
+ % Replace all occurrences of inst_var(InstVar) with
+ % constrained_inst_var(InstVar, ground(shared, none)).
+ %
+:- pred constrain_inst_vars_in_mode(mer_mode::in, mer_mode::out) is det.
+
+ % Replace all occurrences of inst_var(InstVar) with
+ % constrained_inst_var(InstVar, Inst) where InstVar -> Inst
+ % is in the inst_var_sub.
+ % If InstVar is not in the inst_var_sub, default to ground(shared, none).
+ %
+:- pred constrain_inst_vars_in_mode_sub(inst_var_sub::in,
+ mer_mode::in, mer_mode::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Check that for each constrained_inst_var all occurrences have the
+ % same constraint.
+ %
+:- pred inst_var_constraints_are_self_consistent_in_modes(list(mer_mode)::in)
+ is semidet.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -839,5 +862,226 @@
).
%-----------------------------------------------------------------------------%
+
+constrain_inst_vars_in_mode(Mode0, Mode) :-
+ constrain_inst_vars_in_mode_sub(map.init, Mode0, Mode).
+
+constrain_inst_vars_in_mode_sub(InstConstraints, Mode0, Mode) :-
+ (
+ Mode0 = (I0 -> F0),
+ constrain_inst_vars_in_inst(InstConstraints, I0, I),
+ constrain_inst_vars_in_inst(InstConstraints, F0, F),
+ Mode = (I -> F)
+ ;
+ Mode0 = user_defined_mode(Name, Args0),
+ list.map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
+ Mode = user_defined_mode(Name, Args)
+ ).
+
+:- pred constrain_inst_vars_in_inst(inst_var_sub::in,
+ mer_inst::in, mer_inst::out) is det.
+
+constrain_inst_vars_in_inst(InstConstraints, Inst0, Inst) :-
+ (
+ ( Inst0 = not_reached
+ ; Inst0 = free
+ ; Inst0 = free(_)
+ ; Inst0 = ground(_Uniq, none)
+ ; Inst0 = any(_Uniq, none)
+ ),
+ Inst = Inst0
+ ;
+ Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
+ constrain_inst_vars_in_pred_inst_info(InstConstraints,
+ PredInstInfo0, PredInstInfo),
+ Inst = ground(Uniq, higher_order(PredInstInfo))
+ ;
+ Inst0 = any(Uniq, higher_order(PredInstInfo0)),
+ constrain_inst_vars_in_pred_inst_info(InstConstraints,
+ PredInstInfo0, PredInstInfo),
+ Inst = any(Uniq, higher_order(PredInstInfo))
+ ;
+ Inst0 = bound(Uniq, InstResults0, BoundInsts0),
+ (
+ InstResults0 = inst_test_results_fgtc,
+ % There are no inst_vars to substitute.
+ Inst = Inst0
+ ;
+ ( InstResults0 = inst_test_no_results
+ ; InstResults0 = inst_test_results(_, _, _, _)
+ ),
+ list.map(
+ (pred(bound_functor(C, Is0)::in, bound_functor(C, Is)::out)
+ is det :-
+ list.map(constrain_inst_vars_in_inst(InstConstraints),
+ Is0, Is)),
+ BoundInsts0, BoundInsts),
+ % The substitutions inside BoundInsts can invalidate
+ % any of the existing results.
+ Inst = bound(Uniq, inst_test_no_results, BoundInsts)
+ )
+ ;
+ Inst0 = constrained_inst_vars(Vars0, SubInst0),
+ constrain_inst_vars_in_inst(InstConstraints, SubInst0, SubInst1),
+ ( SubInst1 = constrained_inst_vars(SubVars, SubSubInst) ->
+ set.union(Vars0, SubVars, Vars),
+ SubInst = SubSubInst
+ ;
+ Vars = Vars0,
+ SubInst = SubInst1
+ ),
+ Inst = constrained_inst_vars(Vars, SubInst)
+ ;
+ Inst0 = inst_var(Var),
+ ( map.search(InstConstraints, Var, SubInstPrime) ->
+ SubInst = SubInstPrime
+ ;
+ SubInst = ground(shared, none)
+ ),
+ Inst = constrained_inst_vars(set.make_singleton_set(Var), SubInst)
+ ;
+ Inst0 = defined_inst(Name0),
+ constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name),
+ Inst = defined_inst(Name)
+ ;
+ Inst0 = abstract_inst(InstName, SubInsts0),
+ list.map(constrain_inst_vars_in_inst(InstConstraints),
+ SubInsts0, SubInsts),
+ Inst = abstract_inst(InstName, SubInsts)
+ ).
+
+:- pred constrain_inst_vars_in_pred_inst_info(inst_var_sub::in,
+ pred_inst_info::in, pred_inst_info::out) is det.
+
+constrain_inst_vars_in_pred_inst_info(InstConstraints, PII0, PII) :-
+ PII0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
+ list.map(constrain_inst_vars_in_mode_sub(InstConstraints), Modes0, Modes),
+ PII = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det).
+
+:- pred constrain_inst_vars_in_inst_name(inst_var_sub::in,
+ inst_name::in, inst_name::out) is det.
+
+constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name) :-
+ ( Name0 = user_inst(SymName, Args0) ->
+ list.map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
+ Name = user_inst(SymName, Args)
+ ;
+ Name = Name0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+inst_var_constraints_are_self_consistent_in_modes(Modes) :-
+ inst_var_constraints_are_consistent_in_modes(Modes, map.init, _).
+
+:- pred inst_var_constraints_are_consistent_in_modes(list(mer_mode)::in,
+ inst_var_sub::in, inst_var_sub::out) is semidet.
+
+inst_var_constraints_are_consistent_in_modes(Modes, !Sub) :-
+ list.foldl(inst_var_constraints_are_consistent_in_mode, Modes, !Sub).
+
+:- pred inst_var_constraints_types_modes_self_consistent(
+ list(type_and_mode)::in) is semidet.
+
+inst_var_constraints_types_modes_self_consistent(TypeAndModes) :-
+ list.foldl(inst_var_constraints_type_mode_consistent, TypeAndModes,
+ map.init, _).
+
+:- pred inst_var_constraints_type_mode_consistent(type_and_mode::in,
+ inst_var_sub::in, inst_var_sub::out) is semidet.
+
+inst_var_constraints_type_mode_consistent(TypeAndMode, !Sub) :-
+ (
+ TypeAndMode = type_only(_)
+ ;
+ TypeAndMode = type_and_mode(_, Mode),
+ inst_var_constraints_are_consistent_in_mode(Mode, !Sub)
+ ).
+
+:- pred inst_var_constraints_are_consistent_in_mode(mer_mode::in,
+ inst_var_sub::in, inst_var_sub::out) is semidet.
+
+inst_var_constraints_are_consistent_in_mode(Mode, !Sub) :-
+ (
+ Mode = (InitialInst -> FinalInst),
+ inst_var_constraints_are_consistent_in_inst(InitialInst, !Sub),
+ inst_var_constraints_are_consistent_in_inst(FinalInst, !Sub)
+ ;
+ Mode = user_defined_mode(_, ArgInsts),
+ inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
+ ).
+
+:- pred inst_var_constraints_are_consistent_in_insts(list(mer_inst)::in,
+ inst_var_sub::in, inst_var_sub::out) is semidet.
+
+inst_var_constraints_are_consistent_in_insts(Insts, !Sub) :-
+ list.foldl(inst_var_constraints_are_consistent_in_inst, Insts, !Sub).
+
+:- pred inst_var_constraints_are_consistent_in_inst(mer_inst::in,
+ inst_var_sub::in, inst_var_sub::out) is semidet.
+
+inst_var_constraints_are_consistent_in_inst(Inst, !Sub) :-
+ (
+ ( Inst = free
+ ; Inst = free(_)
+ ; Inst = not_reached
+ )
+ ;
+ Inst = bound(_, InstResults, BoundInsts),
+ (
+ InstResults = inst_test_results_fgtc
+ ;
+ ( InstResults = inst_test_no_results
+ ; InstResults = inst_test_results(_, _, _, _)
+ ),
+ list.foldl(
+ (pred(bound_functor(_, Insts)::in, in, out) is semidet -->
+ inst_var_constraints_are_consistent_in_insts(Insts)
+ ),
+ BoundInsts, !Sub)
+ )
+ ;
+ ( Inst = ground(_, HOInstInfo)
+ ; Inst = any(_, HOInstInfo)
+ ),
+ (
+ HOInstInfo = none
+ ;
+ HOInstInfo = higher_order(pred_inst_info(_, Modes, _, _)),
+ inst_var_constraints_are_consistent_in_modes(Modes, !Sub)
+ )
+ ;
+ Inst = inst_var(_),
+ unexpected($module, $pred, "unconstrained inst_var")
+ ;
+ Inst = defined_inst(InstName),
+ ( InstName = user_inst(_, ArgInsts) ->
+ inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
+ ;
+ true
+ )
+ ;
+ Inst = abstract_inst(_, ArgInsts),
+ inst_var_constraints_are_consistent_in_insts(ArgInsts, !Sub)
+ ;
+ Inst = constrained_inst_vars(InstVars, SubInst),
+ set.fold(inst_var_constraints_are_consistent_in_inst_var(SubInst),
+ InstVars, !Sub),
+ inst_var_constraints_are_consistent_in_inst(SubInst, !Sub)
+ ).
+
+:- pred inst_var_constraints_are_consistent_in_inst_var(mer_inst::in,
+ inst_var::in, inst_var_sub::in, inst_var_sub::out) is semidet.
+
+inst_var_constraints_are_consistent_in_inst_var(SubInst, InstVar, !Sub) :-
+ ( map.search(!.Sub, InstVar, InstVarInst) ->
+ % Check that the inst_var constraint is consistent with
+ % the previous constraint on this inst_var.
+ InstVarInst = SubInst
+ ;
+ map.det_insert(InstVar, SubInst, !Sub)
+ ).
+
+%-----------------------------------------------------------------------------%
:- end_module parse_tree.prog_mode.
%-----------------------------------------------------------------------------%
cvs diff: Diffing notes
--------------------------------------------------------------------------
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