[m-rev.] for post-commit review: more compiler speedups
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Sep 4 09:06:16 AEST 2009
These are relatively simple, minor local speedups.
Zoltan.
Further compiler speedups.
library/varset.m:
Speed up predicates by avoding making the same decisions over and over
again.
library/tree234.m:
library/map.m:
NEWS:
Add tree234.map_values_only and map.map_values_only.
compiler/add_pragma.m:
compiler/analysis.m:
compiler/code_info.m:
compiler/cse_detection.m:
compiler/cse_detection.m:
compiler/equiv_type_hlds.m:
compiler/global_data.m:
compiler/hlds_out.m:
compiler/hlds_rtti.m:
compiler/inst_graph.m:
compiler/lp_rational.m:
compiler/hlds_out.m:
compiler/mlds_to_il.m:
compiler/modules.m:
compiler/par_conj_gen.m:
compiler/polymorphism.m:
compiler/prog_data.m:
compiler/prog_type_subst.m:
compiler/recompilation.version.m:
compiler/simplify.m:
compiler/stack_layout.m:
compiler/type_util.m:
compiler/unneeded_code.m:
Use the new predicates.
compiler/mark_static_terms.m:
Do not bother traversing from_ground_term_construct scopes.
Remove a redundant test.
compiler/ml_unify_gen.m:
Speed up a predicate by avoding making the same decisions over and over
again.
compiler/mlds.m:
Factor out some code.
compiler/typecheck_info.m:
Operate on vartypes directly as maps; don't transform them
unnecessarily into association lists.
Do not bother to apply empty substitutions.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.509
diff -u -b -r1.509 NEWS
--- NEWS 11 May 2009 05:24:08 -0000 1.509
+++ NEWS 2 Sep 2009 22:58:32 -0000
@@ -258,6 +258,10 @@
map.from_sorted_assoc_list now also constructs the tree directly, so now
it requires its input list to be duplicate-free.
+* We have added tree234.map_values_only and map.map_values_only, which are
+ versions of tree234.map_values and map.map_values which do not give the
+ higher order argument the key associated with the value being transformed.
+
* We have replaced the hash_table and version_hash_table implementations
with separate chaining schemes. Consequently delete works, and double
hashing predicates are not required.
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.95
diff -u -b -r1.95 add_pragma.m
--- compiler/add_pragma.m 19 Aug 2009 07:44:52 -0000 1.95
+++ compiler/add_pragma.m 2 Sep 2009 19:17:37 -0000
@@ -1497,7 +1497,8 @@
MaybeProcIds, Procs0, Procs1, !ModuleInfo, !Specs),
% Remove any imported structure sharing and reuse information for the
% original procedure as they won't be (directly) applicable.
- map.map_values(reset_imported_structure_sharing_reuse, Procs1, Procs),
+ map.map_values_only(reset_imported_structure_sharing_reuse,
+ Procs1, Procs),
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, user_guided_type_specialization,
DoTypeSpec),
@@ -1883,10 +1884,10 @@
MaybeProcIds = yes(ProcIds)
).
-:- pred reset_imported_structure_sharing_reuse(proc_id::in,
+:- pred reset_imported_structure_sharing_reuse(
proc_info::in, proc_info::out) is det.
-reset_imported_structure_sharing_reuse(_, !ProcInfo) :-
+reset_imported_structure_sharing_reuse(!ProcInfo) :-
proc_info_reset_imported_structure_sharing(!ProcInfo),
proc_info_reset_imported_structure_reuse(!ProcInfo).
Index: compiler/analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/analysis.m,v
retrieving revision 1.8
diff -u -b -r1.8 analysis.m
--- compiler/analysis.m 21 Jul 2008 03:10:06 -0000 1.8
+++ compiler/analysis.m 2 Sep 2009 20:11:11 -0000
@@ -1150,20 +1150,21 @@
module_analysis_map(imdg_arc)::out) is det.
clear_imdg_entries_pointing_at(ModuleName, Map0, Map) :-
- map.map_values(clear_imdg_entries_pointing_at_2(ModuleName), Map0, Map).
+ map.map_values_only(clear_imdg_entries_pointing_at_2(ModuleName),
+ Map0, Map).
-:- pred clear_imdg_entries_pointing_at_2(module_name::in, analysis_name::in,
+:- pred clear_imdg_entries_pointing_at_2(module_name::in,
func_analysis_map(imdg_arc)::in,
func_analysis_map(imdg_arc)::out) is det.
-clear_imdg_entries_pointing_at_2(ModuleName, _, FuncMap0, FuncMap) :-
- map.map_values(clear_imdg_entries_pointing_at_3(ModuleName),
+clear_imdg_entries_pointing_at_2(ModuleName, FuncMap0, FuncMap) :-
+ map.map_values_only(clear_imdg_entries_pointing_at_3(ModuleName),
FuncMap0, FuncMap).
-:- pred clear_imdg_entries_pointing_at_3(module_name::in, func_id::in,
+:- pred clear_imdg_entries_pointing_at_3(module_name::in,
list(imdg_arc)::in, list(imdg_arc)::out) is det.
-clear_imdg_entries_pointing_at_3(ModuleName, _, Arcs0, Arcs) :-
+clear_imdg_entries_pointing_at_3(ModuleName, Arcs0, Arcs) :-
list.filter((pred(Arc::in) is semidet :- Arc ^ imdg_caller \= ModuleName),
Arcs0, Arcs).
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.373
diff -u -b -r1.373 code_info.m
--- compiler/code_info.m 11 Jun 2009 07:00:07 -0000 1.373
+++ compiler/code_info.m 2 Sep 2009 20:11:11 -0000
@@ -1243,7 +1243,7 @@
set_follow_vars(abs_follow_vars(StoreMap, MaxMentionedReg + 1), !CI),
get_instmap(!.CI, InstMap),
( instmap_is_reachable(InstMap) ->
- VarLocs = assoc_list.map_values(key_abs_locn_to_lval, AbsVarLocs),
+ VarLocs = assoc_list.map_values_only(abs_locn_to_lval, AbsVarLocs),
place_vars(VarLocs, Code, !CI)
;
% With --opt-no-return-call, the variables that we would have
@@ -1332,7 +1332,7 @@
remake_with_store_map(StoreMap, !CI) :-
map.to_assoc_list(StoreMap, VarLocns),
- VarLvals = assoc_list.map_values(key_abs_locn_to_lval, VarLocns),
+ VarLvals = assoc_list.map_values_only(abs_locn_to_lval, VarLocns),
get_var_locn_info(!.CI, VarLocnInfo0),
reinit_var_locn_state(VarLvals, VarLocnInfo0, VarLocnInfo),
set_var_locn_info(VarLocnInfo, !CI).
@@ -2845,7 +2845,7 @@
get_stack_slots(!.CI, StackSlots),
map.select(StackSlots, FailVars, AbsStackMap),
map.to_assoc_list(AbsStackMap, AbsStackList),
- StackList0 = assoc_list.map_values(key_stack_slot_to_lval,
+ StackList0 = assoc_list.map_values_only(stack_slot_to_lval,
AbsStackList),
make_singleton_sets(StackList0, StackList),
map.from_sorted_assoc_list(StackList, StackMap)
@@ -2948,7 +2948,7 @@
make_stack_resume_map(ResumeVars, StackSlots, StackMap) :-
map.select(StackSlots, ResumeVars, StackMap0),
map.to_assoc_list(StackMap0, AbsStackList),
- StackList0 = assoc_list.map_values(key_stack_slot_to_lval, AbsStackList),
+ StackList0 = assoc_list.map_values_only(stack_slot_to_lval, AbsStackList),
make_singleton_sets(StackList0, StackList),
map.from_sorted_assoc_list(StackList, StackMap).
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.122
diff -u -b -r1.122 cse_detection.m
--- compiler/cse_detection.m 21 Jul 2009 02:08:48 -0000 1.122
+++ compiler/cse_detection.m 2 Sep 2009 20:19:50 -0000
@@ -871,17 +871,12 @@
map.from_assoc_list(OldNew, OldNewMap),
apply_substitutions_to_rtti_varmaps(Renaming, map.init, OldNewMap,
RttiVarMaps0, RttiVarMaps),
- map.map_values(apply_tvar_rename(Renaming), VarTypes0, VarTypes),
+ map.map_values_only(apply_variable_renaming_to_type(Renaming),
+ VarTypes0, VarTypes),
!:CseInfo = !.CseInfo ^ csei_rtti_varmaps := RttiVarMaps,
!:CseInfo = !.CseInfo ^ csei_vartypes := VarTypes.
-:- pred apply_tvar_rename(tvar_renaming::in, prog_var::in,
- mer_type::in, mer_type::out) is det.
-
-apply_tvar_rename(Renaming, _Var, Type0, Type) :-
- apply_variable_renaming_to_type(Renaming, Type0, Type).
-
:- pred find_type_info_locn_tvar_map(rtti_varmaps::in,
map(prog_var, prog_var)::in, tvar::in,
map(type_info_locn, tvar)::in, map(type_info_locn, tvar)::out) is det.
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.55
diff -u -b -r1.55 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 12 Jun 2009 05:21:26 -0000 1.55
+++ compiler/equiv_type_hlds.m 2 Sep 2009 20:20:45 -0000
@@ -298,12 +298,12 @@
is det.
replace_in_cons_table(EqvMap, !ConsTable) :-
- map.map_values(replace_in_cons_defns(EqvMap), !ConsTable).
+ map.map_values_only(replace_in_cons_defns(EqvMap), !ConsTable).
-:- pred replace_in_cons_defns(eqv_map::in, cons_id::in,
+:- pred replace_in_cons_defns(eqv_map::in,
list(hlds_cons_defn)::in, list(hlds_cons_defn)::out) is det.
-replace_in_cons_defns(EqvMap, _ConsId, !ConsDefns) :-
+replace_in_cons_defns(EqvMap, !ConsDefns) :-
list.map(replace_in_cons_defn(EqvMap), !ConsDefns).
:- pred replace_in_cons_defn(eqv_map::in,
Index: compiler/global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/global_data.m,v
retrieving revision 1.39
diff -u -b -r1.39 global_data.m
--- compiler/global_data.m 7 Jul 2009 07:21:57 -0000 1.39
+++ compiler/global_data.m 2 Sep 2009 22:12:58 -0000
@@ -824,31 +824,31 @@
remap_static_cell_info(Remap, !SCI) :-
ScalarMap0 = !.SCI ^ scalar_cell_group_map,
VectorMap0 = !.SCI ^ vector_cell_group_map,
- map.map_values(remap_scalar_cell_group(Remap), ScalarMap0, ScalarMap),
- map.map_values(remap_vector_cell_group(Remap), VectorMap0, VectorMap),
+ map.map_values_only(remap_scalar_cell_group(Remap), ScalarMap0, ScalarMap),
+ map.map_values_only(remap_vector_cell_group(Remap), VectorMap0, VectorMap),
!SCI ^ scalar_cell_group_map := ScalarMap,
!SCI ^ vector_cell_group_map := VectorMap.
-:- pred remap_scalar_cell_group(static_cell_remap_info::in, type_num::in,
+:- pred remap_scalar_cell_group(static_cell_remap_info::in,
scalar_cell_group::in, scalar_cell_group::out) is det.
-remap_scalar_cell_group(Remap, _, !ScalarCellGroup) :-
+remap_scalar_cell_group(Remap, !ScalarCellGroup) :-
Array0 = !.ScalarCellGroup ^ scalar_cell_rev_array,
list.map(remap_common_cell_value(Remap), Array0, Array),
!ScalarCellGroup ^ scalar_cell_rev_array := Array.
-:- pred remap_vector_cell_group(static_cell_remap_info::in, type_num::in,
+:- pred remap_vector_cell_group(static_cell_remap_info::in,
vector_cell_group::in, vector_cell_group::out) is det.
-remap_vector_cell_group(Remap, _, !VectorCellGroup) :-
+remap_vector_cell_group(Remap, !VectorCellGroup) :-
!.VectorCellGroup = vector_cell_group(Counter, Map0),
- map.map_values(remap_vector_contents(Remap), Map0, Map),
+ map.map_values_only(remap_vector_contents(Remap), Map0, Map),
!:VectorCellGroup = vector_cell_group(Counter, Map).
-:- pred remap_vector_contents(static_cell_remap_info::in, int::in,
+:- pred remap_vector_contents(static_cell_remap_info::in,
vector_contents::in, vector_contents::out) is det.
-remap_vector_contents(Remap, _, !Contents) :-
+remap_vector_contents(Remap, !Contents) :-
!.Contents = vector_contents(Values0),
list.map(remap_common_cell_value(Remap), Values0, Values),
!:Contents = vector_contents(Values).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.469
diff -u -b -r1.469 hlds_out.m
--- compiler/hlds_out.m 2 Sep 2009 00:30:15 -0000 1.469
+++ compiler/hlds_out.m 2 Sep 2009 20:33:41 -0000
@@ -3407,7 +3407,7 @@
write_stack_slots(Indent, StackSlots, VarSet, AppendVarNums, !IO) :-
map.to_assoc_list(StackSlots, VarSlotList0),
- VarSlotList = assoc_list.map_values(key_stack_slot_to_abs_locn,
+ VarSlotList = assoc_list.map_values_only(stack_slot_to_abs_locn,
VarSlotList0),
write_var_to_abs_locns(VarSlotList, VarSet, AppendVarNums, Indent, !IO).
Index: compiler/hlds_rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_rtti.m,v
retrieving revision 1.16
diff -u -b -r1.16 hlds_rtti.m
--- compiler/hlds_rtti.m 12 Jun 2009 02:08:58 -0000 1.16
+++ compiler/hlds_rtti.m 2 Sep 2009 20:33:41 -0000
@@ -695,10 +695,7 @@
ConstraintMap0 = !.RttiVarMaps ^ tci_constraint_map,
map.foldl(apply_constraint_key_transformation(Pred), TciMap0,
map.init, TciMap),
- Pred2 = (pred(_::in, V::in, W::out) is det :-
- Pred(V, W)
- ),
- map.map_values(Pred2, TypeMap0, TypeMap),
+ map.map_values_only(Pred, TypeMap0, TypeMap),
map.map_values(apply_constraint_value_transformation(Pred),
ConstraintMap0, ConstraintMap),
!:RttiVarMaps = !.RttiVarMaps ^ tci_varmap := TciMap,
Index: compiler/inst_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_graph.m,v
retrieving revision 1.18
diff -u -b -r1.18 inst_graph.m
--- compiler/inst_graph.m 11 Jun 2009 07:00:10 -0000 1.18
+++ compiler/inst_graph.m 2 Sep 2009 20:33:41 -0000
@@ -363,7 +363,7 @@
merge(InstGraph0, VarSet0, NewInstGraph, NewVarSet, InstGraph, VarSet, Sub) :-
varset.merge_subst_without_names(VarSet0, NewVarSet, VarSet, Sub0),
(
- map.map_values(pred(_::in, term.variable(V, _)::in, V::out) is semidet,
+ map.map_values_only(pred(term.variable(V, _)::in, V::out) is semidet,
Sub0, Sub1)
->
Sub = Sub1
@@ -372,8 +372,8 @@
),
map.foldl((pred(Var0::in, Node0::in, IG0::in, IG::out) is det :-
Node0 = node(Functors0, MaybeParent),
- map.map_values(
- (pred(_::in, Args0::in, Args::out) is det :-
+ map.map_values_only(
+ (pred(Args0::in, Args::out) is det :-
map.apply_to_list(Args0, Sub, Args)),
Functors0, Functors),
Node = node(Functors, MaybeParent),
Index: compiler/lp_rational.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lp_rational.m,v
retrieving revision 1.11
diff -u -b -r1.11 lp_rational.m
--- compiler/lp_rational.m 23 Nov 2007 07:35:10 -0000 1.11
+++ compiler/lp_rational.m 2 Sep 2009 20:38:09 -0000
@@ -902,7 +902,7 @@
:- func negate_lp_terms(lp_terms) = lp_terms.
-negate_lp_terms(Terms) = assoc_list.map_values((func(_, X) = (-X)), Terms).
+negate_lp_terms(Terms) = assoc_list.map_values_only((func(X) = (-X)), Terms).
:- func add_var(map(lp_var, rat), lp_var, rat) = map(lp_var, rat).
@@ -2039,7 +2039,7 @@
else true
),
DivVal = rat.abs(Coefficient),
- !:Terms = map.map_values((func(_, C) = C / DivVal), !.Terms),
+ !:Terms = map.map_values_only((func(C) = C / DivVal), !.Terms),
!:Constant = !.Constant / DivVal
;
% In this case the the coefficient of the variable was zero
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.31
diff -u -b -r1.31 mark_static_terms.m
--- compiler/mark_static_terms.m 2 Sep 2009 00:30:16 -0000 1.31
+++ compiler/mark_static_terms.m 2 Sep 2009 22:11:21 -0000
@@ -89,11 +89,14 @@
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
- % We should special-case the handling of from_ground_term_construct
- % scopes, since these already have all their unifications marked
+ ( Reason = from_ground_term(_TermVar, from_ground_term_construct) ->
+ % These scopes already have all their unifications marked
% as construct_statically.
+ GoalExpr = GoalExpr0
+ ;
goal_mark_static_terms(SubGoal0, SubGoal, !SI),
GoalExpr = scope(Reason, SubGoal)
+ )
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
SI0 = !.SI,
@@ -152,23 +155,23 @@
unification_mark_static_terms(Unification0, Unification, !StaticVars) :-
(
- Unification0 = construct(Var, ConsId, ArgVars, D, HowToConstruct0,
- F, G),
+ Unification0 = construct(Var, ConsId, ArgVars, ArgModes,
+ HowToConstruct0, Unique, SubInfo),
% If all the arguments are static, then the newly constructed variable
% is static too.
( list.all_true(set_tree234.contains(!.StaticVars), ArgVars) ->
HowToConstruct = construct_statically,
- set_tree234.insert(Var, !StaticVars)
- ;
- HowToConstruct = HowToConstruct0
- ),
- ( HowToConstruct = HowToConstruct0 ->
+ set_tree234.insert(Var, !StaticVars),
% This is a minor optimization to improve the efficiency of the
% compiler: don't bother allocating memory if we don't need to.
+ ( HowToConstruct = HowToConstruct0 ->
Unification = Unification0
;
- Unification = construct(Var, ConsId, ArgVars, D, HowToConstruct,
- F, G)
+ Unification = construct(Var, ConsId, ArgVars, ArgModes,
+ HowToConstruct, Unique, SubInfo)
+ )
+ ;
+ Unification = Unification0
)
;
Unification0 = deconstruct(_Var, _ConsId, _ArgVars, _UniModes,
@@ -198,10 +201,9 @@
true
)
;
- Unification0 = simple_test(_, _),
- Unification = Unification0
- ;
- Unification0 = complicated_unify(_, _, _),
+ ( Unification0 = simple_test(_, _)
+ ; Unification0 = complicated_unify(_, _, _)
+ ),
Unification = Unification0
).
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.134
diff -u -b -r1.134 ml_unify_gen.m
--- compiler/ml_unify_gen.m 2 Sep 2009 00:30:19 -0000 1.134
+++ compiler/ml_unify_gen.m 2 Sep 2009 20:38:50 -0000
@@ -2231,25 +2231,19 @@
ConsArgTypes = ArgTypes
),
assoc_list.from_corresponding_lists(Args, ConsArgTypes, ArgConsArgTypes),
-
(
HighLevelData = yes,
- list.map_foldl2(
- construct_ground_term_initializer_hld(ModuleInfo, Context),
+ construct_ground_term_initializers_hld(ModuleInfo, Context,
ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap)
;
HighLevelData = no,
- list.map_foldl2(
- construct_ground_term_initializer_lld(ModuleInfo, Context),
+ construct_ground_term_initializers_lld(ModuleInfo, Context,
ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap)
),
% By construction, boxing the rvals in ExtraInitializers would be a no-op.
SubInitializers = ExtraInitializers ++ ArgInitializers,
- % EntityDefn = mlds_data(MLDS_Type, Initializer, gc_no_stmt),
- % Defn = mlds_defn(EntityName, MLDS_Context, Flags, EntityDefn),
-
% Generate a local static constant for this term.
ConstType = get_type_for_cons_id(Target, HighLevelData, MLDS_Type,
ml_tag_uses_base_class(ConsTag), yes(ConsId)),
@@ -2282,6 +2276,42 @@
GroundTerm = ml_ground_term(Rval, VarType),
svmap.det_insert(Var, GroundTerm, !GroundTermMap).
+%-----------------------------------------------------------------------------%
+
+:- pred construct_ground_term_initializers_hld(module_info::in,
+ prog_context::in,
+ assoc_list(prog_var, mer_type) ::in, list(mlds_initializer)::out,
+ ml_global_data::in, ml_global_data::out,
+ ml_ground_term_map::in, ml_ground_term_map::out) is det.
+
+construct_ground_term_initializers_hld(_, _, [], [],
+ !GlobalData, !GroundTermMap).
+construct_ground_term_initializers_hld(ModuleInfo, Context,
+ [ArgConsArgType | ArgConsArgTypes], [ArgInitializer | ArgInitializers],
+ !GlobalData, !GroundTermMap) :-
+ construct_ground_term_initializer_hld(ModuleInfo, Context,
+ ArgConsArgType, ArgInitializer, !GlobalData, !GroundTermMap),
+ construct_ground_term_initializers_hld(ModuleInfo, Context,
+ ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap).
+
+:- pred construct_ground_term_initializers_lld(module_info::in,
+ prog_context::in,
+ assoc_list(prog_var, mer_type) ::in, list(mlds_initializer)::out,
+ ml_global_data::in, ml_global_data::out,
+ ml_ground_term_map::in, ml_ground_term_map::out) is det.
+
+construct_ground_term_initializers_lld(_, _, [], [],
+ !GlobalData, !GroundTermMap).
+construct_ground_term_initializers_lld(ModuleInfo, Context,
+ [ArgConsArgType | ArgConsArgTypes], [ArgInitializer | ArgInitializers],
+ !GlobalData, !GroundTermMap) :-
+ construct_ground_term_initializer_lld(ModuleInfo, Context,
+ ArgConsArgType, ArgInitializer, !GlobalData, !GroundTermMap),
+ construct_ground_term_initializers_lld(ModuleInfo, Context,
+ ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap).
+
+%-----------------------------------------------------------------------------%
+
:- pred construct_ground_term_initializer_hld(module_info::in,
prog_context::in, pair(prog_var, mer_type) ::in, mlds_initializer::out,
ml_global_data::in, ml_global_data::out,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.174
diff -u -b -r1.174 mlds.m
--- compiler/mlds.m 2 Sep 2009 05:48:00 -0000 1.174
+++ compiler/mlds.m 3 Sep 2009 22:40:20 -0000
@@ -1819,26 +1819,27 @@
% and instead fully convert all Mercury types to MLDS types.
mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :-
+ ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
(
- type_to_ctor_and_args(Type, TypeCtor, [ElemType]),
- TypeCtor = type_ctor(qualified(unqualified("array"), "array"), 1)
+ TypeCtor = type_ctor(qualified(unqualified("array"), "array"), 1),
+ TypeArgs = [ElemType]
->
MLDSElemType = mercury_type_to_mlds_type(ModuleInfo, ElemType),
MLDSType = mlds_mercury_array_type(MLDSElemType)
;
- type_to_ctor_and_args(Type, TypeCtor, [RefType]),
TypeCtor = type_ctor(qualified(mercury_private_builtin_module,
- "store_at_ref_type"), 1)
+ "store_at_ref_type"), 1),
+ TypeArgs = [RefType]
->
MLDSRefType = mercury_type_to_mlds_type(ModuleInfo, RefType),
MLDSType = mlds_ptr_type(MLDSRefType)
;
- type_to_ctor_and_args(Type, TypeCtor, _),
module_info_get_type_table(ModuleInfo, Types),
map.search(Types, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, Body),
- Body = hlds_foreign_type(foreign_type_body(MaybeIL, MaybeC, MaybeJava,
- _MaybeErlang))
+ Body = hlds_foreign_type(ForeignTypeBody),
+ ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
+ _MaybeErlang)
->
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
@@ -1896,13 +1897,19 @@
unexpected(this_file, "target x86_64 with --high-level-code")
;
Target = target_erlang,
- unexpected(this_file, "mercury_type_to_mlds_type: target erlang")
+ unexpected(this_file,
+ "mercury_type_to_mlds_type: target erlang")
),
MLDSType = mlds_foreign_type(ForeignType)
;
classify_type(ModuleInfo, Type) = Category,
ExportedType = to_exported_type(ModuleInfo, Type),
MLDSType = mercury_type(Type, Category, ExportedType)
+ )
+ ;
+ classify_type(ModuleInfo, Type) = Category,
+ ExportedType = to_exported_type(ModuleInfo, Type),
+ MLDSType = mercury_type(Type, Category, ExportedType)
).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.207
diff -u -b -r1.207 mlds_to_il.m
--- compiler/mlds_to_il.m 2 Sep 2009 05:48:01 -0000 1.207
+++ compiler/mlds_to_il.m 3 Sep 2009 22:40:20 -0000
@@ -4579,7 +4579,7 @@
il_info_get_locals_list(Info, Locals) :-
DataRep = Info ^ il_data_rep,
- map.map_values((pred(_K::in, V::in, W::out) is det :-
+ map.map_values_only((pred(V::in, W::out) is det :-
W = mlds_type_to_ilds_type(DataRep, V)),
Info ^ locals, LocalsMap),
map.to_assoc_list(LocalsMap, Locals).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.454
diff -u -b -r1.454 modules.m
--- compiler/modules.m 14 Aug 2009 20:37:47 -0000 1.454
+++ compiler/modules.m 2 Sep 2009 20:50:30 -0000
@@ -725,7 +725,8 @@
% If a type in the implementation section isn't dummy and doesn't have
% foreign type alternatives, make it abstract.
- map.map_values(make_impl_type_abstract(BothTypesMap), !ImplTypesMap),
+ map.map_values_only(make_impl_type_abstract(BothTypesMap),
+ !ImplTypesMap),
% If there is an exported type declaration for a type with an abstract
% declaration in the implementation (usually it will originally
@@ -926,11 +927,11 @@
Result = [Head | NewTail]
).
-:- pred make_impl_type_abstract(type_defn_map::in, type_ctor::in,
+:- pred make_impl_type_abstract(type_defn_map::in,
assoc_list(type_defn, item_type_defn_info)::in,
assoc_list(type_defn, item_type_defn_info)::out) is det.
-make_impl_type_abstract(TypeDefnMap, _TypeCtor, !TypeDefnPairs) :-
+make_impl_type_abstract(TypeDefnMap, !TypeDefnPairs) :-
(
!.TypeDefnPairs =
[parse_tree_du_type(Ctors, MaybeEqCmp) - ItemTypeDefn0],
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.39
diff -u -b -r1.39 par_conj_gen.m
--- compiler/par_conj_gen.m 6 Jan 2009 03:56:26 -0000 1.39
+++ compiler/par_conj_gen.m 2 Sep 2009 20:51:37 -0000
@@ -267,7 +267,7 @@
get_known_variables(!.CI, Variables),
set.list_to_set(Variables, LiveVars),
map.select(AllSlots, LiveVars, StoreMap0),
- StoreMap = map.map_values(key_stack_slot_to_abs_locn, StoreMap0),
+ StoreMap = map.map_values_only(stack_slot_to_abs_locn, StoreMap0),
generate_branch_end(StoreMap, MaybeEnd0, MaybeEnd, SaveCode0, !CI),
replace_stack_vars_by_parent_sv(SaveCode0, SaveCode),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.342
diff -u -b -r1.342 polymorphism.m
--- compiler/polymorphism.m 19 Aug 2009 07:44:56 -0000 1.342
+++ compiler/polymorphism.m 2 Sep 2009 20:51:37 -0000
@@ -515,8 +515,8 @@
polymorphism_introduce_exists_casts_pred(ModuleInfo, !PredInfo) :-
pred_info_get_procedures(!.PredInfo, Procs0),
- map.map_values(
- (pred(_::in, !.ProcInfo::in, !:ProcInfo::out) is det :-
+ map.map_values_only(
+ (pred(!.ProcInfo::in, !:ProcInfo::out) is det :-
% Add the extra goals to each procedure.
introduce_exists_casts_proc(ModuleInfo, !.PredInfo, !ProcInfo)
), Procs0, Procs),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.218
diff -u -b -r1.218 prog_data.m
--- compiler/prog_data.m 11 Jun 2009 08:28:27 -0000 1.218
+++ compiler/prog_data.m 2 Sep 2009 21:09:10 -0000
@@ -1862,17 +1862,17 @@
tvarset_merge_renaming(TVarSetA, TVarSetB, TVarSet, Renaming) :-
varset.merge_subst(TVarSetA, TVarSetB, TVarSet, Subst),
- map.map_values(convert_subst_term_to_tvar, Subst, Renaming).
+ map.map_values_only(convert_subst_term_to_tvar, Subst, Renaming).
tvarset_merge_renaming_without_names(TVarSetA, TVarSetB, TVarSet, Renaming) :-
varset.merge_subst_without_names(TVarSetA, TVarSetB, TVarSet, Subst),
- map.map_values(convert_subst_term_to_tvar, Subst, Renaming).
+ map.map_values_only(convert_subst_term_to_tvar, Subst, Renaming).
-:- pred convert_subst_term_to_tvar(tvar::in, term(tvar_type)::in, tvar::out)
+:- pred convert_subst_term_to_tvar(term(tvar_type)::in, tvar::out)
is det.
-convert_subst_term_to_tvar(_, variable(TVar, _), TVar).
-convert_subst_term_to_tvar(_, functor(_, _, _), _) :-
+convert_subst_term_to_tvar(variable(TVar, _), TVar).
+convert_subst_term_to_tvar(functor(_, _, _), _) :-
unexpected(this_file, "non-variable found in renaming").
%-----------------------------------------------------------------------------%
Index: compiler/prog_type_subst.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type_subst.m,v
retrieving revision 1.5
diff -u -b -r1.5 prog_type_subst.m
--- compiler/prog_type_subst.m 1 Dec 2006 15:04:17 -0000 1.5
+++ compiler/prog_type_subst.m 2 Sep 2009 21:09:57 -0000
@@ -295,31 +295,13 @@
%-----------------------------------------------------------------------------%
apply_variable_renaming_to_vartypes(Renaming, !Map) :-
- map.map_values(apply_variable_renaming_to_vartypes_2(Renaming), !Map).
-
-:- pred apply_variable_renaming_to_vartypes_2(tvar_renaming::in, prog_var::in,
- mer_type::in, mer_type::out) is det.
-
-apply_variable_renaming_to_vartypes_2(Renaming, _, !Type) :-
- apply_variable_renaming_to_type(Renaming, !Type).
+ map.map_values_only(apply_variable_renaming_to_type(Renaming), !Map).
apply_subst_to_vartypes(Subst, !VarTypes) :-
- map.map_values(apply_subst_to_vartypes_2(Subst), !VarTypes).
-
-:- pred apply_subst_to_vartypes_2(tsubst::in, prog_var::in,
- mer_type::in, mer_type::out) is det.
-
-apply_subst_to_vartypes_2(Subst, _, !Type) :-
- apply_subst_to_type(Subst, !Type).
+ map.map_values_only(apply_subst_to_type(Subst), !VarTypes).
apply_rec_subst_to_vartypes(Subst, !VarTypes) :-
- map.map_values(apply_rec_subst_to_vartypes_2(Subst), !VarTypes).
-
-:- pred apply_rec_subst_to_vartypes_2(tsubst::in, prog_var::in,
- mer_type::in, mer_type::out) is det.
-
-apply_rec_subst_to_vartypes_2(Subst, _, !Type) :-
- apply_rec_subst_to_type(Subst, !Type).
+ map.map_values_only(apply_rec_subst_to_type(Subst), !VarTypes).
%-----------------------------------------------------------------------------%
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.67
diff -u -b -r1.67 recompilation.version.m
--- compiler/recompilation.version.m 2 Sep 2009 00:30:23 -0000 1.67
+++ compiler/recompilation.version.m 2 Sep 2009 21:10:53 -0000
@@ -208,18 +208,18 @@
),
% Pragmas can apply to typeclass methods.
- map.map_values(distribute_pragma_items_class_items(MaybePredOrFunc,
+ map.map_values_only(distribute_pragma_items_class_items(MaybePredOrFunc,
SymName, Arity, Item, Section),
extract_ids(!.GatheredItems, typeclass_item), GatheredTypeClasses),
!:GatheredItems = update_ids(!.GatheredItems, typeclass_item,
GatheredTypeClasses).
:- pred distribute_pragma_items_class_items(maybe(pred_or_func)::in,
- sym_name::in, arity::in, item::in, section::in, pair(string, int)::in,
+ sym_name::in, arity::in, item::in, section::in,
assoc_list(section, item)::in, assoc_list(section, item)::out) is det.
distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity,
- Item, Section, _, !ClassItems) :-
+ Item, Section, !ClassItems) :-
(
% Does this pragma match any of the methods of this class.
list.member(_ - ClassItem, !.ClassItems),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.243
diff -u -b -r1.243 simplify.m
--- compiler/simplify.m 21 Jul 2009 04:10:42 -0000 1.243
+++ compiler/simplify.m 2 Sep 2009 21:10:53 -0000
@@ -3113,10 +3113,8 @@
is det.
renaming_transitive_closure(VarRenaming0, VarRenaming) :-
- map.map_values(
- (pred(_::in, Value0::in, Value::out) is det :-
- find_renamed_var(VarRenaming0, Value0, Value)
- ), VarRenaming0, VarRenaming).
+ map.map_values_only(find_renamed_var(VarRenaming0),
+ VarRenaming0, VarRenaming).
%-----------------------------------------------------------------------------%
@@ -3807,10 +3805,7 @@
!Info) :-
simplify_info_get_var_types(!.Info, VarTypes0),
simplify_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
- ApplyTSubst = (pred(_::in, T0::in, T::out) is det :-
- apply_rec_subst_to_type(TSubst, T0, T)
- ),
- map.map_values(ApplyTSubst, VarTypes0, VarTypes),
+ map.map_values_only(apply_rec_subst_to_type(TSubst), VarTypes0, VarTypes),
map.det_insert(map.init, ToVar, FromVar, Renaming),
apply_substitutions_to_rtti_varmaps(map.init, TSubst, Renaming,
RttiVarMaps0, RttiVarMaps1),
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.145
diff -u -b -r1.145 stack_layout.m
--- compiler/stack_layout.m 25 Nov 2008 07:46:42 -0000 1.145
+++ compiler/stack_layout.m 2 Sep 2009 21:12:16 -0000
@@ -1466,13 +1466,12 @@
!StaticCellInfo),
add_scalar_static_cell(PTIRvalsTypes, PTIVectorAddr, !StaticCellInfo),
PTIVectorRval = const(llconst_data_addr(PTIVectorAddr, no)),
- map.map_values(convert_slot_to_locn_map, TVarSlotMap, TVarLocnMap),
+ map.map_values_only(convert_slot_to_locn_map, TVarSlotMap, TVarLocnMap),
construct_tvar_vector(TVarLocnMap, TVarVectorRval, !StaticCellInfo).
-:- pred convert_slot_to_locn_map(tvar::in, table_locn::in,
- set(layout_locn)::out) is det.
+:- pred convert_slot_to_locn_map(table_locn::in, set(layout_locn)::out) is det.
-convert_slot_to_locn_map(_TVar, SlotLocn, LvalLocns) :-
+convert_slot_to_locn_map(SlotLocn, LvalLocns) :-
(
SlotLocn = table_locn_direct(SlotNum),
LvalLocn = locn_direct(reg(reg_r, SlotNum))
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.198
diff -u -b -r1.198 type_util.m
--- compiler/type_util.m 26 Aug 2009 16:05:56 -0000 1.198
+++ compiler/type_util.m 2 Sep 2009 21:12:16 -0000
@@ -1167,12 +1167,12 @@
!.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
apply_variable_renaming_to_constraint_list(Renaming, Unproven0, Unproven),
apply_variable_renaming_to_constraint_list(Renaming, Assumed0, Assumed),
- Pred = (pred(_::in, C0::in, C::out) is det :-
+ Pred = (pred(C0::in, C::out) is det :-
set.to_sorted_list(C0, L0),
apply_variable_renaming_to_constraint_list(Renaming, L0, L),
set.list_to_set(L, C)
),
- map.map_values(Pred, Redundant0, Redundant),
+ map.map_values_only(Pred, Redundant0, Redundant),
map.keys(Ancestors0, AncestorsKeys0),
map.values(Ancestors0, AncestorsValues0),
apply_variable_renaming_to_prog_constraint_list(Renaming, AncestorsKeys0,
@@ -1186,12 +1186,12 @@
!.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
apply_subst_to_constraint_list(Subst, Unproven0, Unproven),
apply_subst_to_constraint_list(Subst, Assumed0, Assumed),
- Pred = (pred(_::in, C0::in, C::out) is det :-
+ Pred = (pred(C0::in, C::out) is det :-
set.to_sorted_list(C0, L0),
apply_subst_to_constraint_list(Subst, L0, L),
set.list_to_set(L, C)
),
- map.map_values(Pred, Redundant0, Redundant),
+ map.map_values_only(Pred, Redundant0, Redundant),
map.keys(Ancestors0, AncestorsKeys0),
map.values(Ancestors0, AncestorsValues0),
apply_subst_to_prog_constraint_list(Subst, AncestorsKeys0,
@@ -1205,12 +1205,12 @@
!.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
apply_rec_subst_to_constraint_list(Subst, Unproven0, Unproven),
apply_rec_subst_to_constraint_list(Subst, Assumed0, Assumed),
- Pred = (pred(_::in, C0::in, C::out) is det :-
+ Pred = (pred(C0::in, C::out) is det :-
set.to_sorted_list(C0, L0),
apply_rec_subst_to_constraint_list(Subst, L0, L),
set.list_to_set(L, C)
),
- map.map_values(Pred, Redundant0, Redundant),
+ map.map_values_only(Pred, Redundant0, Redundant),
map.keys(Ancestors0, AncestorsKeys0),
map.values(Ancestors0, AncestorsValues0),
apply_rec_subst_to_prog_constraint_list(Subst, AncestorsKeys0,
@@ -1288,34 +1288,16 @@
%-----------------------------------------------------------------------------%
apply_variable_renaming_to_constraint_map(Renaming, !ConstraintMap) :-
- map.map_values(apply_variable_renaming_to_constraint_map_2(Renaming),
+ map.map_values_only(apply_variable_renaming_to_prog_constraint(Renaming),
!ConstraintMap).
-:- pred apply_variable_renaming_to_constraint_map_2(tvar_renaming::in,
- constraint_id::in, prog_constraint::in, prog_constraint::out) is det.
-
-apply_variable_renaming_to_constraint_map_2(Renaming, _Key, !Value) :-
- apply_variable_renaming_to_prog_constraint(Renaming, !Value).
-
apply_subst_to_constraint_map(Subst, !ConstraintMap) :-
- map.map_values(apply_subst_to_constraint_map_2(Subst), !ConstraintMap).
-
-:- pred apply_subst_to_constraint_map_2(tsubst::in, constraint_id::in,
- prog_constraint::in, prog_constraint::out) is det.
-
-apply_subst_to_constraint_map_2(Subst, _Key, !Value) :-
- apply_subst_to_prog_constraint(Subst, !Value).
+ map.map_values_only(apply_subst_to_prog_constraint(Subst), !ConstraintMap).
apply_rec_subst_to_constraint_map(Subst, !ConstraintMap) :-
- map.map_values(apply_rec_subst_to_constraint_map_2(Subst),
+ map.map_values_only(apply_rec_subst_to_prog_constraint(Subst),
!ConstraintMap).
-:- pred apply_rec_subst_to_constraint_map_2(tsubst::in, constraint_id::in,
- prog_constraint::in, prog_constraint::out) is det.
-
-apply_rec_subst_to_constraint_map_2(Subst, _Key, !Value) :-
- apply_rec_subst_to_prog_constraint(Subst, !Value).
-
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.28
diff -u -b -r1.28 typecheck_info.m
--- compiler/typecheck_info.m 2 Sep 2009 00:37:35 -0000 1.28
+++ compiler/typecheck_info.m 2 Sep 2009 21:26:27 -0000
@@ -1,7 +1,7 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
-% Copyright (C) 2005-2009 The University of Melbourne.
+% Copyright (C) 2005-2008 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -382,6 +382,7 @@
:- import_module int.
:- import_module pair.
:- import_module string.
+:- import_module set.
:- import_module svmap.
:- import_module term.
:- import_module varset.
@@ -429,16 +430,16 @@
type_assign_get_constraint_proofs(TypeAssign, ConstraintProofs0),
type_assign_get_constraint_map(TypeAssign, ConstraintMap0),
- map.keys(VarTypes0, Vars),
( map.is_empty(TypeBindings) ->
- VarTypes = VarTypes0,
+ VarTypes1 = VarTypes0,
ConstraintProofs = ConstraintProofs0,
- ConstraintMap1 = ConstraintMap0
- ;
- map.to_sorted_assoc_list(VarTypes0, VarTypesList0),
- expand_types(VarTypesList0, TypeBindings, [], RevVarTypesList),
- list.reverse(RevVarTypesList, VarTypesList),
- map.from_sorted_assoc_list(VarTypesList, VarTypes),
+ ConstraintMap1 = ConstraintMap0,
+ map.values(VarTypes1, Types1),
+ type_vars_list(Types1, TypeVars1)
+ ;
+ map.map_foldl(expand_types(TypeBindings), VarTypes0, VarTypes1,
+ set.init, TypeVarsSet1),
+ set.to_sorted_list(TypeVarsSet1, TypeVars1),
apply_rec_subst_to_constraint_proofs(TypeBindings,
ConstraintProofs0, ConstraintProofs),
apply_rec_subst_to_constraint_map(TypeBindings,
@@ -488,77 +489,54 @@
% (XXX should we do the same for TypeConstraints and ConstraintProofs
% too?)
- map.values(VarTypes, Types),
- type_vars_list(Types, TypeVars0),
map.values(OldExplicitVarTypes, ExplicitTypes),
type_vars_list(ExplicitTypes, ExplicitTypeVars0),
map.keys(ExistTypeRenaming, ExistQVarsToBeRenamed),
list.delete_elems(OldExistQVars, ExistQVarsToBeRenamed,
ExistQVarsToRemain),
list.condense([ExistQVarsToRemain, HeadTypeParams,
- TypeVars0, ExplicitTypeVars0], TypeVars1),
- list.sort_and_remove_dups(TypeVars1, TypeVars),
+ TypeVars1, ExplicitTypeVars0], TypeVars2),
+ list.sort_and_remove_dups(TypeVars2, TypeVars),
% Next, create a new typevarset with the same number of variables.
varset.squash(OldTypeVarSet, TypeVars, NewTypeVarSet, TSubst),
- % Finally, rename the types and type class constraints to use
- % the new typevarset type variables.
- apply_variable_renaming_to_type_list(TSubst, Types, NewTypes),
- assoc_list.from_corresponding_lists(Vars, NewTypes, VarsNewTypes),
- % Creating the NewVarTypes map from a list that map.m knows is sorted
- % gives a speedup.
- map.from_sorted_assoc_list(VarsNewTypes, NewVarTypes),
- map.apply_to_list(HeadTypeParams, TSubst, NewHeadTypeParams),
+ % Finally, if necessary, rename the types and type class constraints
+ % to use the new typevarset type variables.
retrieve_prog_constraints(HLDSTypeConstraints, TypeConstraints),
+ ( map.is_empty(TSubst) ->
+ NewVarTypes = VarTypes1,
+ NewHeadTypeParams = HeadTypeParams,
+ NewTypeConstraints = TypeConstraints,
+ NewConstraintProofs = ConstraintProofs,
+ NewConstraintMap = ConstraintMap
+ ;
+ map.map_values_only(apply_variable_renaming_to_type(TSubst),
+ VarTypes1, NewVarTypes),
+ map.apply_to_list(HeadTypeParams, TSubst, NewHeadTypeParams),
apply_variable_renaming_to_prog_constraints(TSubst,
TypeConstraints, NewTypeConstraints),
apply_variable_renaming_to_constraint_proofs(TSubst,
ConstraintProofs, NewConstraintProofs),
apply_variable_renaming_to_constraint_map(TSubst,
ConstraintMap, NewConstraintMap)
+ )
;
TypeAssignSet = [],
unexpected(this_file, "internal error in typecheck_info_get_vartypes")
).
% Fully expand the types of the variables by applying the type bindings.
+ % We also accumulate the set of type variables we have seen so far,
+ % since doing so saves having to do a separate traversal for that.
%
- % The number of variables can be huge here (hundred of thousands for
- % Doug Auclair's training_cars program). The code below prevents stack
- % overflows in grades that do not permit tail recursion.
- %
-:- pred expand_types(assoc_list(prog_var, mer_type)::in, tsubst::in,
- assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out)
- is det.
+:- pred expand_types(tsubst::in, prog_var::in, mer_type::in, mer_type::out,
+ set(tvar)::in, set(tvar)::out) is det.
-expand_types(VarTypes, TypeSubst, !RevVarTypes) :-
- expand_types_2(VarTypes, TypeSubst, 1000, LeftOverVarTypes, !RevVarTypes),
- (
- LeftOverVarTypes = []
- ;
- LeftOverVarTypes = [_ | _],
- expand_types(LeftOverVarTypes, TypeSubst, !RevVarTypes)
- ).
-
-:- pred expand_types_2(assoc_list(prog_var, mer_type)::in, tsubst::in, int::in,
- assoc_list(prog_var, mer_type)::out,
- assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out)
- is det.
-
-expand_types_2([], _, _, [], !VarTypes).
-expand_types_2([VarType0 | VarTypes0], TypeSubst, VarsToDo, LeftOverVarTypes,
- !RevVarTypes) :-
- ( VarsToDo < 0 ->
- LeftOverVarTypes = [VarType0 | VarTypes0]
- ;
- VarType0 = Var - Type0,
+expand_types(TypeSubst, _Var, Type0, Type, !TypeVarsSet) :-
apply_rec_subst_to_type(TypeSubst, Type0, Type),
- VarType = Var - Type,
- !:RevVarTypes = [VarType | !.RevVarTypes],
- expand_types_2(VarTypes0, TypeSubst, VarsToDo - 1, LeftOverVarTypes,
- !RevVarTypes)
- ).
+ type_vars(Type, TypeVars),
+ set.insert_list(!.TypeVarsSet, TypeVars, !:TypeVarsSet).
% We rename any existentially quantified type variables which get mapped
% to other type variables, unless they are mapped to universally quantified
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.49
diff -u -b -r1.49 unneeded_code.m
--- compiler/unneeded_code.m 23 Dec 2008 01:37:42 -0000 1.49
+++ compiler/unneeded_code.m 2 Sep 2009 22:11:21 -0000
@@ -423,7 +423,7 @@
%
% This code requires compound goals containing impure code
% to also be marked impure.
- map.map_values(demand_var_everywhere, !WhereNeededMap)
+ map.map_values_only(demand_var_everywhere, !WhereNeededMap)
;
true
).
@@ -615,10 +615,9 @@
%---------------------------------------------------------------------------%
-:- pred demand_var_everywhere(prog_var::in, where_needed::in,
- where_needed::out) is det.
+:- pred demand_var_everywhere(where_needed::in, where_needed::out) is det.
-demand_var_everywhere(_Var, _WhereNeeded0, everywhere).
+demand_var_everywhere(_WhereNeeded0, everywhere).
%---------------------------------------------------------------------------%
@@ -681,7 +680,7 @@
),
GoalPath = goal_info_get_goal_path(GoalInfo0),
BranchPoint = branch_point(GoalPath, alt_switch(MaybeNumAlt)),
- map.map_values(demand_var_everywhere, !WhereNeededMap),
+ map.map_values_only(demand_var_everywhere, !WhereNeededMap),
map.init(BranchNeededMap0),
unneeded_process_cases(Cases0, Cases, BranchPoint, 1,
InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, GoalPath,
@@ -695,7 +694,7 @@
;
GoalExpr0 = disj(Disjuncts0),
GoalPath = goal_info_get_goal_path(GoalInfo0),
- map.map_values(demand_var_everywhere, !WhereNeededMap),
+ map.map_values_only(demand_var_everywhere, !WhereNeededMap),
unneeded_process_disj(Disjuncts0, Disjuncts, InitInstMap, FinalInstMap,
VarTypes, ModuleInfo, Options, GoalPath,
!.WhereNeededMap, !.WhereNeededMap, !:WhereNeededMap,
@@ -706,7 +705,7 @@
GoalExpr0 = if_then_else(Quant, Cond0, Then0, Else0),
GoalPath = goal_info_get_goal_path(GoalInfo0),
BranchPoint = branch_point(GoalPath, alt_ite),
- map.map_values(demand_var_everywhere, !WhereNeededMap),
+ map.map_values_only(demand_var_everywhere, !WhereNeededMap),
unneeded_process_ite(Cond0, Cond, Then0, Then, Else0, Else,
BranchPoint, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
Options, GoalPath, !WhereNeededMap, !RefinedGoals, !Changed),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.116
diff -u -b -r1.116 map.m
--- library/map.m 16 Jul 2009 02:48:33 -0000 1.116
+++ library/map.m 2 Sep 2009 17:57:30 -0000
@@ -426,6 +426,13 @@
:- mode map.map_values(pred(in, in, out) is det, in, out) is det.
:- mode map.map_values(pred(in, in, out) is semidet, in, out) is semidet.
+ % Same as map.map_values, but do not pass the key to the given predicate.
+ %
+:- func map.map_values_only(func(V) = W, map(K, V)) = map(K, W).
+:- pred map.map_values_only(pred(V, W), map(K, V), map(K, W)).
+:- mode map.map_values_only(pred(in, out) is det, in, out) is det.
+:- mode map.map_values_only(pred(in, out) is semidet, in, out) is semidet.
+
% Apply a transformation predicate to all the values in a map,
% while continuously updating an accumulator.
%
@@ -909,6 +916,9 @@
map.map_values(Pred, Map0, Map) :-
tree234.map_values(Pred, Map0, Map).
+map.map_values_only(Pred, Map0, Map) :-
+ tree234.map_values_only(Pred, Map0, Map).
+
map.map_foldl(Pred, !Map, !Acc) :-
tree234.map_foldl(Pred, !Map, !Acc).
@@ -1172,6 +1182,10 @@
P = (pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
map.map_values(P, M1, M2).
+map.map_values_only(F, M1) = M2 :-
+ P = (pred(Y::in, Z::out) is det :- Z = F(Y) ),
+ map.map_values_only(P, M1, M2).
+
map.intersect(F, M1, M2) = M3 :-
P = (pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
map.intersect(P, M1, M2, M3).
Index: library/tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.65
diff -u -b -r1.65 tree234.m
--- library/tree234.m 16 Feb 2009 03:27:19 -0000 1.65
+++ library/tree234.m 2 Sep 2009 17:57:43 -0000
@@ -254,6 +254,12 @@
:- mode tree234.map_values(pred(in, in, out) is det, in, out) is det.
:- mode tree234.map_values(pred(in, in, out) is semidet, in, out) is semidet.
+:- func tree234.map_values_only(func(V) = W, tree234(K, V)) = tree234(K, W).
+
+:- pred tree234.map_values_only(pred(V, W), tree234(K, V), tree234(K, W)).
+:- mode tree234.map_values_only(pred(in, out) is det, in, out) is det.
+:- mode tree234.map_values_only(pred(in, out) is semidet, in, out) is semidet.
+
:- pred tree234.map_foldl(pred(K, V, W, A, A), tree234(K, V), tree234(K, W),
A, A).
:- mode tree234.map_foldl(pred(in, in, out, di, uo) is det,
@@ -2732,6 +2738,32 @@
tree234.map_values(Pred, Right0, Right),
Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+tree234.map_values_only(_Pred, empty, empty).
+tree234.map_values_only(Pred, Tree0, Tree) :-
+ Tree0 = two(K0, V0, Left0, Right0),
+ Pred(V0, W0),
+ tree234.map_values_only(Pred, Left0, Left),
+ tree234.map_values_only(Pred, Right0, Right),
+ Tree = two(K0, W0, Left, Right).
+tree234.map_values_only(Pred, Tree0, Tree) :-
+ Tree0 = three(K0, V0, K1, V1, Left0, Middle0, Right0),
+ Pred(V0, W0),
+ Pred(V1, W1),
+ tree234.map_values_only(Pred, Left0, Left),
+ tree234.map_values_only(Pred, Middle0, Middle),
+ tree234.map_values_only(Pred, Right0, Right),
+ Tree = three(K0, W0, K1, W1, Left, Middle, Right).
+tree234.map_values_only(Pred, Tree0, Tree) :-
+ Tree0 = four(K0, V0, K1, V1, K2, V2, Left0, LMid0, RMid0, Right0),
+ Pred(V0, W0),
+ Pred(V1, W1),
+ Pred(V2, W2),
+ tree234.map_values_only(Pred, Left0, Left),
+ tree234.map_values_only(Pred, LMid0, LMid),
+ tree234.map_values_only(Pred, RMid0, RMid),
+ tree234.map_values_only(Pred, Right0, Right),
+ Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+
%------------------------------------------------------------------------------%
tree234.map_foldl(_Pred, empty, empty, !A).
@@ -2849,6 +2881,10 @@
P = (pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
tree234.map_values(P, T1, T2).
+tree234.map_values_only(F, T1) = T2 :-
+ P = (pred(Y::in, Z::out) is det :- Z = F(Y) ),
+ tree234.map_values_only(P, T1, T2).
+
%-----------------------------------------------------------------------------%
% The default pretty_printer formatting for key_value_pair will do what
Index: library/varset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/varset.m,v
retrieving revision 1.82
diff -u -b -r1.82 varset.m
--- library/varset.m 28 Sep 2007 03:17:19 -0000 1.82
+++ library/varset.m 2 Sep 2009 22:24:54 -0000
@@ -459,21 +459,18 @@
%-----------------------------------------------------------------------------%
- % We scan through the second varset, introducing a fresh
- % variable into the first varset for each var in the
- % second, and building up a substitution which maps
- % the variables in the second varset into the corresponding
- % fresh variable in the first varset. We then apply
+ % We scan through the second varset, introducing a fresh variable
+ % into the first varset for each var in the second, and building up
+ % a substitution which maps the variables in the second varset into
+ % the corresponding fresh variable in the first varset. We then apply
% this substitution to the list of terms.
varset.merge(VarSetA, VarSetB, TermList0, VarSet, TermList) :-
- IncludeNames = yes,
- varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst),
+ varset.merge_subst(VarSetA, VarSetB, VarSet, Subst),
term.apply_substitution_to_list(TermList0, Subst, TermList).
varset.merge_without_names(VarSetA, VarSetB, TermList0, VarSet, TermList) :-
- IncludeNames = no,
- varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst),
+ varset.merge_subst_without_names(VarSetA, VarSetB, VarSet, Subst),
term.apply_substitution_to_list(TermList0, Subst, TermList).
%-----------------------------------------------------------------------------%
@@ -482,46 +479,59 @@
% in the next block.
varset.merge_renaming(VarSetA, VarSetB, VarSet, Subst) :-
- IncludeNames = yes,
- varset.merge_renaming_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-varset.merge_renaming_without_names(VarSetA, VarSetB, VarSet, Subst) :-
- IncludeNames = no,
- varset.merge_renaming_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-:- pred varset.merge_renaming_inc(bool::in, varset(T)::in, varset(T)::in,
- varset(T)::out, map(var(T), var(T))::out) is det.
-
-varset.merge_renaming_inc(IncludeNames, VarSetA, VarSetB, VarSet, Renaming) :-
- VarSetB = varset(MaxId, Names, Values),
- term.init_var_supply(N),
- map.init(Renaming0),
- varset.merge_renaming_inc_2(IncludeNames, N, MaxId, Names, Values,
- VarSetA, VarSet, Renaming0, Renaming).
-
-:- pred varset.merge_renaming_inc_2(bool::in, var_supply(T)::in,
- var_supply(T)::in, map(var(T), string)::in,
- map(var(T), term(T))::in, varset(T)::in, varset(T)::out,
+ VarSetB = varset(SupplyB, NamesB, _ValuesB),
+ term.init_var_supply(SupplyB0),
+ VarSetA = varset(SupplyA, NamesA, ValuesA),
+ map.init(Subst0),
+ varset.merge_renaming_2(SupplyB0, SupplyB, NamesB,
+ SupplyA, Supply, NamesA, Names, Subst0, Subst),
+ VarSet = varset(Supply, Names, ValuesA).
+
+:- pred varset.merge_renaming_2(var_supply(T)::in, var_supply(T)::in,
+ map(var(T), string)::in,
+ var_supply(T)::in, var_supply(T)::out,
+ map(var(T), string)::in, map(var(T), string)::out,
map(var(T), var(T))::in, map(var(T), var(T))::out) is det.
-varset.merge_renaming_inc_2(IncludeNames, N, Max, Names, Values, !VarSet,
- !Renaming) :-
- ( N = Max ->
+varset.merge_renaming_2(!.SupplyB, MaxSupplyB, NamesB,
+ !Supply, !Names, !Subst) :-
+ ( !.SupplyB = MaxSupplyB ->
true
;
- varset.new_var(!.VarSet, VarId, !:VarSet),
- term.create_var(N, VarN, N1),
- (
- IncludeNames = yes,
- map.search(Names, VarN, Name)
- ->
- varset.name_var(!.VarSet, VarId, Name, !:VarSet)
+ term.create_var(!.Supply, Var, !:Supply),
+ term.create_var(!.SupplyB, VarB, !:SupplyB),
+ ( map.search(NamesB, VarB, NameB) ->
+ map.det_insert(!.Names, Var, NameB, !:Names)
;
true
),
- map.set(!.Renaming, VarN, VarId, !:Renaming),
- varset.merge_renaming_inc_2(IncludeNames, N1, Max, Names, Values,
- !VarSet, !Renaming)
+ map.det_insert(!.Subst, VarB, Var, !:Subst),
+ varset.merge_renaming_2(!.SupplyB, MaxSupplyB, NamesB,
+ !Supply, !Names, !Subst)
+ ).
+
+varset.merge_renaming_without_names(VarSetA, VarSetB, VarSet, Subst) :-
+ VarSetB = varset(SupplyB, _NamesB, _ValuesB),
+ term.init_var_supply(SupplyB0),
+ VarSetA = varset(SupplyA, NamesA, ValuesA),
+ map.init(Subst0),
+ varset.merge_renaming_without_names_2(SupplyB0, SupplyB,
+ SupplyA, Supply, Subst0, Subst),
+ VarSet = varset(Supply, NamesA, ValuesA).
+
+:- pred varset.merge_renaming_without_names_2(var_supply(T)::in,
+ var_supply(T)::in, var_supply(T)::in, var_supply(T)::out,
+ map(var(T), var(T))::in, map(var(T), var(T))::out) is det.
+
+varset.merge_renaming_without_names_2(!.SupplyB, MaxSupplyB, !Supply, !Subst) :-
+ ( !.SupplyB = MaxSupplyB ->
+ true
+ ;
+ term.create_var(!.Supply, Var, !:Supply),
+ term.create_var(!.SupplyB, VarB, !:SupplyB),
+ map.det_insert(!.Subst, VarB, Var, !:Subst),
+ varset.merge_renaming_without_names_2(!.SupplyB, MaxSupplyB,
+ !Supply, !Subst)
).
%-----------------------------------------------------------------------------%
@@ -530,46 +540,61 @@
% in the previous block.
varset.merge_subst(VarSetA, VarSetB, VarSet, Subst) :-
- IncludeNames = yes,
- varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-varset.merge_subst_without_names(VarSetA, VarSetB, VarSet, Subst) :-
- IncludeNames = no,
- varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-:- pred varset.merge_subst_inc(bool::in, varset(T)::in, varset(T)::in,
- varset(T)::out, substitution(T)::out) is det.
-
-varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst) :-
- VarSetB = varset(MaxId, Names, Values),
- term.init_var_supply(N),
+ VarSetB = varset(SupplyB, NamesB, _ValuesB),
+ term.init_var_supply(SupplyB0),
+ VarSetA = varset(SupplyA, NamesA, ValuesA),
map.init(Subst0),
- varset.merge_subst_inc_2(IncludeNames, N, MaxId, Names, Values,
- VarSetA, VarSet, Subst0, Subst).
-
-:- pred varset.merge_subst_inc_2(bool::in, var_supply(T)::in,
- var_supply(T)::in, map(var(T), string)::in,
- map(var(T), term(T))::in, varset(T)::in, varset(T)::out,
+ varset.merge_subst_2(SupplyB0, SupplyB, NamesB,
+ SupplyA, Supply, NamesA, Names, Subst0, Subst),
+ VarSet = varset(Supply, Names, ValuesA).
+
+:- pred varset.merge_subst_2(var_supply(T)::in, var_supply(T)::in,
+ map(var(T), string)::in,
+ var_supply(T)::in, var_supply(T)::out,
+ map(var(T), string)::in, map(var(T), string)::out,
substitution(T)::in, substitution(T)::out) is det.
-varset.merge_subst_inc_2(IncludeNames, N, Max, Names, Values, !VarSet,
- !Subst) :-
- ( N = Max ->
+varset.merge_subst_2(!.SupplyB, MaxSupplyB, NamesB,
+ !Supply, !Names, !Subst) :-
+ ( !.SupplyB = MaxSupplyB ->
true
;
- varset.new_var(!.VarSet, VarId, !:VarSet),
- term.create_var(N, VarN, N1),
- (
- IncludeNames = yes,
- map.search(Names, VarN, Name)
- ->
- varset.name_var(!.VarSet, VarId, Name, !:VarSet)
+ term.create_var(!.Supply, Var, !:Supply),
+ term.create_var(!.SupplyB, VarB, !:SupplyB),
+ ( map.search(NamesB, VarB, NameB) ->
+ map.det_insert(!.Names, Var, NameB, !:Names)
;
true
),
- map.set(!.Subst, VarN, term.variable(VarId, context_init), !:Subst),
- varset.merge_subst_inc_2(IncludeNames, N1, Max, Names, Values,
- !VarSet, !Subst)
+ Replacement = term.variable(Var, context_init),
+ map.det_insert(!.Subst, VarB, Replacement, !:Subst),
+ varset.merge_subst_2(!.SupplyB, MaxSupplyB, NamesB,
+ !Supply, !Names, !Subst)
+ ).
+
+varset.merge_subst_without_names(VarSetA, VarSetB, VarSet, Subst) :-
+ VarSetB = varset(SupplyB, _NamesB, _ValuesB),
+ term.init_var_supply(SupplyB0),
+ VarSetA = varset(SupplyA, NamesA, ValuesA),
+ map.init(Subst0),
+ varset.merge_subst_without_names_2(SupplyB0, SupplyB,
+ SupplyA, Supply, Subst0, Subst),
+ VarSet = varset(Supply, NamesA, ValuesA).
+
+:- pred varset.merge_subst_without_names_2( var_supply(T)::in,
+ var_supply(T)::in, var_supply(T)::in, var_supply(T)::out,
+ substitution(T)::in, substitution(T)::out) is det.
+
+varset.merge_subst_without_names_2(!.SupplyB, MaxSupplyB, !Supply, !Subst) :-
+ ( !.SupplyB = MaxSupplyB ->
+ true
+ ;
+ term.create_var(!.Supply, Var, !:Supply),
+ term.create_var(!.SupplyB, VarB, !:SupplyB),
+ Replacement = term.variable(Var, context_init),
+ map.det_insert(!.Subst, VarB, Replacement, !:Subst),
+ varset.merge_subst_without_names_2(!.SupplyB, MaxSupplyB,
+ !Supply, !Subst)
).
%-----------------------------------------------------------------------------%
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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