[m-rev.] for post-commit review: make zm_eq20.m compile in 2.5s (hlc.gc)
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Sep 16 12:31:16 AEST 2009
For review by anyone, but I would especially like Mark to review
restrict_rtti_varmaps in hlds_rtti.m.
Zoltan.
Significant further improvements in the worst-case behavior of the compiler
when working on code such as zm_eq20.m and zm_coerce_tuples.m. On my laptop,
zm_eq20.m and zm_coerce_tuples.m now compile in 2.5s and 12.9s respectively;
the times before were 86.4s and 54.0s. The sizes of the stage 110 HLDS dumps
(the stage just after lambda expansion) go from 8.5Mb and 760Mb (!) to
just 0.4Mb and 7.4Mb respectively.
compiler/polymorphism.m:
Remember not just which typeinfos we have constructed, but also what
type_ctor_infos, base_typeclass_infos and typeclass_infos we have
constructed, so that we don't have to construct them again for code
that is executed later.
The maintenance of the additional maps adds some overhead that in
typical code probably cannot be made back through the resulting
reductions in the workload of later compiler passes. However,
the avoidance of horrible worst-case behavior trumps small increases
in normal-case runtime.
For zm_coerce_tuples, polymorphism.m now generates as good HLDS code
as can be expected within each lambda expression. There is still
a lot of duplicated code, with each copy being in a different lambda
expression, but factoring out these commonalities will require a
fundamentally different approach.
Avoid using the misleading prefix "TypeClassInfo_" on the names of
variables holding base_typeclass_infos.
compiler/ml_elim_nested.m:
Don't look for static definitions where they cannot occur anymore.
When deciding whether a definition needs to be hoisted out,
don't look for it being used in later static definitions,
since all the static definitions are now elsewhere.
In order to avoid running the compiler out of nondet stack space
on zm_coerce_tuples.m, avoid the use of enumerating all the
definitions in a potentially huge piece of MLDS by backtracking.
compiler/hlds_rtti.m:
Avoid enumerating all the members of a potentially huge list
by backtracking in order to avoid running the compiler out of nondet
stack space on zm_coerce_tuples.m.
I first tried to do this by constructing the list with det code,
but this turned out not to fix the underlying problem, which was that
almost all of the list's elements were copies of each other, and we
then had to get rid of the copies. The actual fix is to gather the
types we need directly as a set.
Provide restrict_rtti_varmaps for use by lambda.m.
Give the field names of the rtti_varmaps type a distinguishing prefix.
compiler/lambda.m:
The fundamental reason for the bad performance of the equiv_type_hlds
pass on zm_coerce_tuples.m was that even with the recent improvements
to polymorphism.m, a couple of big predicates had about ten thousand
variables each, and when lambda.m created about 200 new procedures
from the lambda expressions inside them, it duplicated those huge
vartypes and rtti_varmaps for each one.
The fix is to restrict the vartypes and the rtti_varmaps of both
the newly created procedures and the old procedure they were taken from
to the variables that actually occur in them.
We could potentially avoid the need to restrict the rtti_varmap
of the original procedure for the new procedures created for lambda
goals by having polymorphism.m give each rhs_lambda_goal its own
rtti_varmap in the first place, but that would be future work.
Use the "no lambda" version of quantification after the lambda pass,
since we have just removed all the lambdas from the goal being
quantified.
Give the predicates of this module more expressive names.
compiler/mercury_compile.m:
Conform to the change in lambda.m.
compiler/equiv_type_hlds.m:
Use specialized versions of the predicates in equiv_type.m, since
the general versions do some things (finding circularities, recording
used modules) that this pass does not need. Use some new predicates
from the standard library to reduce overhead.
compiler/ml_optimize.m:
In order to avoid running the compiler out of nondet stack space
on zm_coerce_tuples.m, avoid the use of enumerating all the members
of a potentially huge list by backtracking.
Move a cheap test before a more expensive one.
compiler/modes.m:
compiler/modecheck_unify.m:
Avoid some unnecessary overheads when modechecking typeinfos and
related variables. One overhead was iteration over a list of exactly
one element, another is a redundant lookup of the variable's type,
and the third is the redundant setting of the unify context.
compiler/inst_match.m:
Use set_tree234s instead sets to keep track of expansions in one group
of predicates indicated by benchmarking.
library/list.m:
Add a new predicate, list.find_first_match, which is a version of
filter that returns only the first matching item. This is for use
in ml_elim_nested.m.
Make list.sort_and_remove_dups remove duplicates as it goes,
not all at the end, since this (a) allows us to avoid a separate
duplicate-elimination pass at the end, and (b) any duplicate eliminated
in one merge pass reduces the workload for any later merge passes.
Put some code in its proper order, since preserving tail recursion
in Prolog is no longer an issue.
library/map.m:
Add versions of map.foldl{,2,3} and map.map_foldl{,2,3} that do not
pass the key to the higher order argument, for use by some of the
compiler modules above.
Group the declarations of all the foldr predicates together.
library/tree.m:
Make the same changes as in map.m, in order to implement map.m's new
predicates.
library/varset.m:
Minor style improvements.
library/set_tree234.m:
Fix a wrong comment.
NEWS:
Mention the new additions to the library.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.511
diff -u -b -r1.511 NEWS
--- NEWS 4 Sep 2009 02:53:52 -0000 1.511
+++ NEWS 15 Sep 2009 07:19:26 -0000
@@ -40,9 +40,6 @@
Numbers not in base 10 are assumed to denote bit patterns and are not
checked for overflow.
-* We have added extra modes to many of the fold style predicates in the
- library in order to better support (mostly-)unique accumulators.
-
* A module for handling directed graphs, digraph.m, has been added. This
supersedes relation.m and svrelation.m in that has a more consistent
interface (which supports state variable notation), provides more type
@@ -56,9 +53,14 @@
user-specifiable formatting for arbitrary types. Further use of pprint is
deprecated.
+* We have added extra modes to many of the fold style predicates in the
+ library in order to better support (mostly-)unique accumulators.
+
* The foldr family of functions and predicates has been added to the map
and tree234 modules. We have also extended the arities for map_foldl
- to map_foldl3 in both modules.
+ to map_foldl3 in both modules, and added versions of both map_foldl*
+ and just plain foldl* in which the higher order argument does not take
+ the key as an argument.
* The following functions have been added to the integer module:
integer.from_base_string/2
@@ -118,6 +120,7 @@
list.split_upto/4
list.contains/2
list.find_index_of_match/4
+ list.find_first_match/3
We have also added versions of list.foldl/4 and list.foldr/4 that have
determinism multi.
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/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.58
diff -u -b -r1.58 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 8 Sep 2009 02:43:32 -0000 1.58
+++ compiler/equiv_type_hlds.m 15 Sep 2009 03:04:40 -0000
@@ -46,6 +46,7 @@
:- import_module parse_tree.equiv_type.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_type_subst.
:- import_module recompilation.
:- import_module bool.
@@ -371,22 +372,18 @@
!.EquivTypeInfo, MaybeRecompInfo0, MaybeRecompInfo),
module_info_set_maybe_recompilation_info(MaybeRecompInfo, !ModuleInfo),
- pred_info_get_procedures(!.PredInfo, Procs0),
- map.map_foldl(
- replace_in_proc(EqvMap), Procs0, Procs,
- {!.ModuleInfo, !.PredInfo, !.Cache},
- {!:ModuleInfo, !:PredInfo, !:Cache}),
- pred_info_set_procedures(Procs, !PredInfo),
+ pred_info_get_procedures(!.PredInfo, ProcMap0),
+ map.map_values_foldl3(replace_in_proc(EqvMap), ProcMap0, ProcMap,
+ !ModuleInfo, !PredInfo, !Cache),
+ pred_info_set_procedures(ProcMap, !PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
).
-:- pred replace_in_proc(eqv_map::in, proc_id::in,
- proc_info::in, proc_info::out,
- {module_info, pred_info, inst_cache}::in,
- {module_info, pred_info, inst_cache}::out) is det.
+:- pred replace_in_proc(eqv_map::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, pred_info::in, pred_info::out,
+ inst_cache::in, inst_cache::out) is det.
-replace_in_proc(EqvMap, _, !ProcInfo, {!.ModuleInfo, !.PredInfo, !.Cache},
- {!:ModuleInfo, !:PredInfo, !:Cache}) :-
+replace_in_proc(EqvMap, !ProcInfo, !ModuleInfo, !PredInfo, !Cache) :-
some [!TVarSet] (
pred_info_get_typevarset(!.PredInfo, !:TVarSet),
@@ -405,12 +402,7 @@
),
proc_info_get_vartypes(!.ProcInfo, VarTypes0),
- map.map_foldl(
- (pred(_::in, VarType0::in, VarType::out,
- !.TVarSet::in, !:TVarSet::out) is det :-
- equiv_type.replace_in_type(EqvMap,
- VarType0, VarType, _, !TVarSet, no, _)
- ),
+ map.map_values_foldl(hlds_replace_in_type(EqvMap),
VarTypes0, VarTypes, !TVarSet),
proc_info_set_vartypes(VarTypes, !ProcInfo),
@@ -419,22 +411,20 @@
list.foldl2(
(pred(OldType::in, !.TMap::in, !:TMap::out,
!.TVarSet::in, !:TVarSet::out) is det :-
- equiv_type.replace_in_type(EqvMap, OldType, NewType, _,
- !TVarSet, no, _),
+ hlds_replace_in_type(EqvMap, OldType, NewType, !TVarSet),
svmap.set(OldType, NewType, !TMap)
), AllTypes, map.init, TypeMap, !TVarSet),
- rtti_varmaps_transform_types(
- (pred(!.VarMapType::in, !:VarMapType::out) is det :-
- map.lookup(TypeMap, !VarMapType)
- ), RttiVarMaps0, RttiVarMaps),
+ rtti_varmaps_transform_types(map.lookup(TypeMap),
+ RttiVarMaps0, RttiVarMaps),
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
proc_info_get_goal(!.ProcInfo, Goal0),
+ ReplaceInfo0 = replace_info(!.ModuleInfo, !.PredInfo, !.ProcInfo,
+ !.TVarSet, !.Cache, no),
replace_in_goal(EqvMap, Goal0, Goal, Changed,
- replace_info(!.ModuleInfo, !.PredInfo, !.ProcInfo, !.TVarSet,
- !.Cache, no),
- replace_info(!:ModuleInfo, !:PredInfo, !:ProcInfo, !:TVarSet,
- _XXX, Recompute)),
+ ReplaceInfo0, ReplaceInfo),
+ ReplaceInfo = replace_info(!:ModuleInfo, !:PredInfo, !:ProcInfo,
+ !:TVarSet, _XXX, Recompute),
(
Changed = yes,
proc_info_set_goal(Goal, !ProcInfo)
@@ -454,6 +444,151 @@
%-----------------------------------------------------------------------------%
+ % Replace equivalence types in a given type.
+ %
+:- pred hlds_replace_in_type(eqv_map::in, mer_type::in, mer_type::out,
+ tvarset::in, tvarset::out) is det.
+
+hlds_replace_in_type(EqvMap, Type0, Type, !VarSet) :-
+ hlds_replace_in_type_2(EqvMap, [], Type0, Type, _Changed, !VarSet).
+
+:- pred hlds_replace_in_type_2(eqv_map::in, list(type_ctor)::in,
+ mer_type::in, mer_type::out, bool::out,
+ tvarset::in, tvarset::out) is det.
+
+hlds_replace_in_type_2(EqvMap, TypeCtorsAlreadyExpanded,
+ Type0, Type, Changed, !VarSet) :-
+ (
+ ( Type0 = type_variable(_, _)
+ ; Type0 = builtin_type(_)
+ ),
+ Type = Type0,
+ Changed = no
+ ;
+ Type0 = defined_type(SymName, TypeArgs0, Kind),
+ hlds_replace_in_type_list_2(EqvMap, TypeCtorsAlreadyExpanded,
+ TypeArgs0, TypeArgs, no, ArgsChanged, !VarSet),
+ Arity = list.length(TypeArgs),
+ TypeCtor = type_ctor(SymName, Arity),
+ hlds_replace_type_ctor(EqvMap, TypeCtorsAlreadyExpanded, Type0,
+ TypeCtor, TypeArgs, Kind, Type, ArgsChanged, Changed, !VarSet)
+ ;
+ Type0 = higher_order_type(ArgTypes0, MaybeRetType0, Purity,
+ EvalMethod),
+ (
+ MaybeRetType0 = yes(RetType0),
+ hlds_replace_in_type_2(EqvMap, TypeCtorsAlreadyExpanded,
+ RetType0, RetType, RetChanged, !VarSet),
+ MaybeRetType = yes(RetType)
+ ;
+ MaybeRetType0 = no,
+ MaybeRetType = no,
+ RetChanged = no
+ ),
+ hlds_replace_in_type_list_2(EqvMap, TypeCtorsAlreadyExpanded,
+ ArgTypes0, ArgTypes, RetChanged, Changed, !VarSet),
+ (
+ Changed = yes,
+ Type = higher_order_type(ArgTypes, MaybeRetType, Purity,
+ EvalMethod)
+ ;
+ Changed = no,
+ Type = Type0
+ )
+ ;
+ Type0 = tuple_type(Args0, Kind),
+ hlds_replace_in_type_list_2(EqvMap, TypeCtorsAlreadyExpanded,
+ Args0, Args, no, Changed, !VarSet),
+ (
+ Changed = yes,
+ Type = tuple_type(Args, Kind)
+ ;
+ Changed = no,
+ Type = Type0
+ )
+ ;
+ Type0 = apply_n_type(Var, Args0, Kind),
+ hlds_replace_in_type_list_2(EqvMap, TypeCtorsAlreadyExpanded,
+ Args0, Args, no, Changed, !VarSet),
+ (
+ Changed = yes,
+ Type = apply_n_type(Var, Args, Kind)
+ ;
+ Changed = no,
+ Type = Type0
+ )
+ ;
+ Type0 = kinded_type(RawType0, Kind),
+ hlds_replace_in_type_2(EqvMap, TypeCtorsAlreadyExpanded,
+ RawType0, RawType, Changed, !VarSet),
+ (
+ Changed = yes,
+ Type = kinded_type(RawType, Kind)
+ ;
+ Changed = no,
+ Type = Type0
+ )
+ ).
+
+:- pred hlds_replace_in_type_list_2(eqv_map::in, list(type_ctor)::in,
+ list(mer_type)::in, list(mer_type)::out, bool::in, bool::out,
+ tvarset::in, tvarset::out) is det.
+
+hlds_replace_in_type_list_2(_EqvMap, _Seen, [], [], !Changed, !VarSet).
+hlds_replace_in_type_list_2(EqvMap, Seen, [Type0 | Types0], [Type | Types],
+ !Changed, !VarSet) :-
+ hlds_replace_in_type_2(EqvMap, Seen, Type0, Type, TypeChanged, !VarSet),
+ bool.or(!.Changed, TypeChanged, !:Changed),
+ hlds_replace_in_type_list_2(EqvMap, Seen, Types0, Types,
+ !Changed, !VarSet).
+
+:- pred hlds_replace_type_ctor(eqv_map::in, list(type_ctor)::in, mer_type::in,
+ type_ctor::in, list(mer_type)::in, kind::in, mer_type::out,
+ bool::in, bool::out, tvarset::in, tvarset::out) is det.
+
+hlds_replace_type_ctor(EqvMap, TypeCtorsAlreadyExpanded0, Type0,
+ TypeCtor, ArgTypes, Kind, Type, !Changed, !VarSet) :-
+ ( list.member(TypeCtor, TypeCtorsAlreadyExpanded0) ->
+ AlreadyExpanded = yes
+ ;
+ AlreadyExpanded = no
+ ),
+ (
+ map.search(EqvMap, TypeCtor, eqv_type_body(EqvVarSet, Params0, Body0)),
+
+ % Don't merge in the variable names from the type declaration to avoid
+ % creating multiple variables with the same name so that
+ % `varset.create_name_var_map' can be used on the resulting tvarset.
+ % make_hlds uses `varset.create_name_var_map' to match up type
+ % variables in `:- pragma type_spec' declarations and explicit type
+ % qualifications with the type variables in the predicate's
+ % declaration.
+
+ tvarset_merge_renaming_without_names(!.VarSet, EqvVarSet, !:VarSet,
+ Renaming),
+ AlreadyExpanded = no
+ ->
+ map.apply_to_list(Params0, Renaming, Params),
+ apply_variable_renaming_to_type(Renaming, Body0, Body1),
+ map.from_corresponding_lists(Params, ArgTypes, Subst),
+ apply_subst_to_type(Subst, Body1, Body),
+ TypeCtorsAlreadyExpanded = [TypeCtor | TypeCtorsAlreadyExpanded0],
+ hlds_replace_in_type_2(EqvMap, TypeCtorsAlreadyExpanded,
+ Body, Type, _BodyChanged, !VarSet),
+ !:Changed = yes
+ ;
+ (
+ !.Changed = yes,
+ TypeCtor = type_ctor(SymName, _Arity),
+ Type = defined_type(SymName, ArgTypes, Kind)
+ ;
+ !.Changed = no,
+ Type = Type0
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
% Note that we go out of our way to avoid duplicating unchanged
% insts and modes. This means we don't need to hash-cons those
% insts to avoid losing sharing.
Index: compiler/hlds_rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_rtti.m,v
retrieving revision 1.17
diff -u -b -r1.17 hlds_rtti.m
--- compiler/hlds_rtti.m 3 Sep 2009 23:07:27 -0000 1.17
+++ compiler/hlds_rtti.m 16 Sep 2009 02:02:53 -0000
@@ -22,6 +22,7 @@
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
+:- import_module array.
:- import_module assoc_list.
:- import_module bool.
:- import_module list.
@@ -168,6 +169,13 @@
%
:- pred rtti_varmaps_init(rtti_varmaps::out) is det.
+ % Given an array in which the entry for a variable's integer form is true
+ % iff the variable is actually used in a procedure body, restrict the
+ % rtti_varmaps for that procedure to the variables needed.
+ %
+:- pred restrict_rtti_varmaps(array(bool)::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
% Succeeds iff the rtti_varmaps contain no information about any
% type variables.
%
@@ -333,7 +341,7 @@
:- import_module map.
:- import_module pair.
-:- import_module solutions.
+:- import_module set_tree234.
:- import_module string.
:- import_module svmap.
:- import_module term.
@@ -394,42 +402,40 @@
:- type rtti_varmaps
---> rtti_varmaps(
- tci_varmap :: typeclass_info_varmap,
- ti_varmap :: type_info_varmap,
- ti_type_map :: type_info_type_map,
- tci_constraint_map :: typeclass_info_constraint_map
+ rv_tci_varmap :: typeclass_info_varmap,
+ rv_ti_varmap :: type_info_varmap,
+ rv_ti_type_map :: type_info_type_map,
+ rv_tci_constraint_map :: typeclass_info_constraint_map
).
% A typeclass_info_varmap is a map which for each type class constraint
- % records which variable contains the typeclass_info for that
- % constraint. The constraints covered by this map are those which
- % are passed in as head arguments and those which are produced as
- % existential constraints from calls or deconstructions. These are
- % the constraints for which it is safe to reuse the variable associated
- % with the constraint.
+ % records which variable contains the typeclass_info for that constraint.
+ % The constraints covered by this map are those which are passed in
+ % as head arguments and those which are produced as existential constraints
+ % from calls or deconstructions. These are constraints for which it is safe
+ % to reuse the variable associated with the constraint.
%
:- type typeclass_info_varmap == map(prog_constraint, prog_var).
- % A type_info_varmap is a map which for each type variable
- % records where the type_info for that type variable is stored.
+ % A type_info_varmap is a map which for each type variable records
+ % where the type_info for that type variable is stored.
%
- % XXX this doesn't record the information that we want. For a
- % constraint such as foo(list(T)) we can't properly record the
- % location of the type_info for T, since it does not occupy a slot
- % in the typeclass_info directly, but is inside the type_info for
- % list(T).
+ % XXX This doesn't record the information that we want. For a constraint
+ % such as foo(list(T)) we can't properly record the location of the
+ % type_info for T, since it does not occupy a slot in the typeclass_info
+ % directly, but is inside the type_info for list(T).
%
:- type type_info_varmap == map(tvar, type_info_locn).
- % Every program variable which holds a type_info is a key in this
- % map. The value associated with a given key is the type that the
- % type_info is for.
+ % Every program variable which holds a type_info is a key in this map.
+ % The value associated with a given key is the type that the type_info
+ % is for.
%
:- type type_info_type_map == map(prog_var, mer_type).
- % Every program variable which holds a typeclass_info is a key in this
- % map. The value associated with a given key is the prog_constraint
- % that the typeclass_info is for.
+ % Every program variable which holds a typeclass_info is a key in this map.
+ % The value associated with a given key is the prog_constraint that
+ % the typeclass_info is for.
%
:- type typeclass_info_constraint_map == map(prog_var, prog_constraint).
@@ -439,47 +445,133 @@
map.init(TypeMap),
map.init(ConstraintMap).
-rtti_varmaps_no_tvars(VarMaps) :-
- map.is_empty(VarMaps ^ ti_varmap).
+restrict_rtti_varmaps(VarUses, !RttiVarMaps) :-
+ % This code makes the assumption that if a type_ctor_info, type_info,
+ % base_typeclass_info or typeclass_info variable is not needed, then
+ % any code that refers to the constraints reachable from those variables
+ % has also been removed from the procedure. (This would happen by being
+ % moved to a procedure of its own by lambda.m.)
+ !.RttiVarMaps = rtti_varmaps(TCIMap0, TIMap0, TypeMap0, ConstraintMap0),
+
+ map.to_assoc_list(TIMap0, TIList0),
+ filter_type_info_varmap(TIList0, [], RevTIList, VarUses),
+ list.reverse(RevTIList, TIList),
+ map.from_sorted_assoc_list(TIList, TIMap),
+
+ map.to_assoc_list(TypeMap0, TypeList0),
+ filter_type_info_map(TypeList0, [], RevTypeList, VarUses),
+ list.reverse(RevTypeList, TypeList),
+ map.from_sorted_assoc_list(TypeList, TypeMap),
+
+ map.to_assoc_list(ConstraintMap0, ConstraintList0),
+ filter_constraint_map(ConstraintList0, [], RevConstraintList,
+ TCIMap0, TCIMap, VarUses),
+ list.reverse(RevConstraintList, ConstraintList),
+ map.from_sorted_assoc_list(ConstraintList, ConstraintMap),
+
+ !:RttiVarMaps = rtti_varmaps(TCIMap, TIMap, TypeMap, ConstraintMap).
+
+:- pred filter_type_info_varmap(assoc_list(tvar, type_info_locn)::in,
+ assoc_list(tvar, type_info_locn)::in,
+ assoc_list(tvar, type_info_locn)::out,
+ array(bool)::in) is det.
+
+filter_type_info_varmap([], !RevTVarLocns, _VarUses).
+filter_type_info_varmap([TVarLocn | TVarLocns], !RevTVarLocns, VarUses) :-
+ TVarLocn = _TVar - Locn,
+ ( Locn = type_info(Var)
+ ; Locn = typeclass_info(Var, _)
+ ),
+ VarNum = var_to_int(Var),
+ array.unsafe_lookup(VarUses, VarNum, Used),
+ (
+ Used = yes,
+ !:RevTVarLocns = [TVarLocn | !.RevTVarLocns]
+ ;
+ Used = no
+ ),
+ filter_type_info_varmap(TVarLocns, !RevTVarLocns, VarUses).
+
+:- pred filter_type_info_map(assoc_list(prog_var, mer_type)::in,
+ assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out,
+ array(bool)::in) is det.
+
+filter_type_info_map([], !RevVarTypes, _VarUses).
+filter_type_info_map([VarType | VarTypes], !RevVarTypes, VarUses) :-
+ VarType = Var - _Type,
+ VarNum = var_to_int(Var),
+ array.unsafe_lookup(VarUses, VarNum, Used),
+ (
+ Used = yes,
+ !:RevVarTypes = [VarType | !.RevVarTypes]
+ ;
+ Used = no
+ ),
+ filter_type_info_map(VarTypes, !RevVarTypes, VarUses).
+
+:- pred filter_constraint_map(assoc_list(prog_var, prog_constraint)::in,
+ assoc_list(prog_var, prog_constraint)::in,
+ assoc_list(prog_var, prog_constraint)::out,
+ typeclass_info_varmap::in, typeclass_info_varmap::out,
+ array(bool)::in) is det.
+
+filter_constraint_map([], !RevVarConstraints, !TCIMap, _VarUses).
+filter_constraint_map([VarConstraint | VarConstraints], !RevVarConstraints,
+ !TCIMap, VarUses) :-
+ VarConstraint = Var - Constraint,
+ VarNum = var_to_int(Var),
+ array.unsafe_lookup(VarUses, VarNum, Used),
+ (
+ Used = yes,
+ !:RevVarConstraints = [VarConstraint | !.RevVarConstraints]
+ ;
+ Used = no,
+ map.delete(!.TCIMap, Constraint, !:TCIMap)
+ ),
+ filter_constraint_map(VarConstraints, !RevVarConstraints,
+ !TCIMap, VarUses).
+
+rtti_varmaps_no_tvars(RttiVarMaps) :-
+ map.is_empty(RttiVarMaps ^ rv_ti_varmap).
-rtti_lookup_type_info_locn(VarMaps, TVar, Locn) :-
- map.lookup(VarMaps ^ ti_varmap, TVar, Locn).
+rtti_lookup_type_info_locn(RttiVarMaps, TVar, Locn) :-
+ map.lookup(RttiVarMaps ^ rv_ti_varmap, TVar, Locn).
-rtti_search_type_info_locn(VarMaps, TVar, Locn) :-
- map.search(VarMaps ^ ti_varmap, TVar, Locn).
+rtti_search_type_info_locn(RttiVarMaps, TVar, Locn) :-
+ map.search(RttiVarMaps ^ rv_ti_varmap, TVar, Locn).
-rtti_lookup_typeclass_info_var(VarMaps, Constraint, ProgVar) :-
- map.lookup(VarMaps ^ tci_varmap, Constraint, ProgVar).
+rtti_lookup_typeclass_info_var(RttiVarMaps, Constraint, ProgVar) :-
+ map.lookup(RttiVarMaps ^ rv_tci_varmap, Constraint, ProgVar).
-rtti_search_typeclass_info_var(VarMaps, Constraint, ProgVar) :-
- map.search(VarMaps ^ tci_varmap, Constraint, ProgVar).
+rtti_search_typeclass_info_var(RttiVarMaps, Constraint, ProgVar) :-
+ map.search(RttiVarMaps ^ rv_tci_varmap, Constraint, ProgVar).
-rtti_varmaps_var_info(VarMaps, Var, VarInfo) :-
- ( map.search(VarMaps ^ ti_type_map, Var, Type) ->
+rtti_varmaps_var_info(RttiVarMaps, Var, VarInfo) :-
+ ( map.search(RttiVarMaps ^ rv_ti_type_map, Var, Type) ->
VarInfo = type_info_var(Type)
- ; map.search(VarMaps ^ tci_constraint_map, Var, Constraint) ->
+ ; map.search(RttiVarMaps ^ rv_tci_constraint_map, Var, Constraint) ->
VarInfo = typeclass_info_var(Constraint)
;
VarInfo = non_rtti_var
).
-rtti_det_insert_type_info_locn(TVar, Locn, !VarMaps) :-
- Map0 = !.VarMaps ^ ti_varmap,
+rtti_det_insert_type_info_locn(TVar, Locn, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ rv_ti_varmap,
map.det_insert(Map0, TVar, Locn, Map),
- !:VarMaps = !.VarMaps ^ ti_varmap := Map,
- maybe_check_type_info_var(Locn, TVar, !VarMaps).
+ !RttiVarMaps ^ rv_ti_varmap := Map,
+ maybe_check_type_info_var(Locn, TVar, !RttiVarMaps).
-rtti_set_type_info_locn(TVar, Locn, !VarMaps) :-
- Map0 = !.VarMaps ^ ti_varmap,
+rtti_set_type_info_locn(TVar, Locn, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ rv_ti_varmap,
map.set(Map0, TVar, Locn, Map),
- !:VarMaps = !.VarMaps ^ ti_varmap := Map,
- maybe_check_type_info_var(Locn, TVar, !VarMaps).
+ !:RttiVarMaps = !.RttiVarMaps ^ rv_ti_varmap := Map,
+ maybe_check_type_info_var(Locn, TVar, !RttiVarMaps).
:- pred maybe_check_type_info_var(type_info_locn::in, tvar::in,
rtti_varmaps::in, rtti_varmaps::out) is det.
-maybe_check_type_info_var(type_info(Var), TVar, !VarMaps) :-
- ( map.search(!.VarMaps ^ ti_type_map, Var, Type) ->
+maybe_check_type_info_var(type_info(Var), TVar, !RttiVarMaps) :-
+ ( map.search(!.RttiVarMaps ^ rv_ti_type_map, Var, Type) ->
( Type = type_variable(TVar, _) ->
true
;
@@ -488,84 +580,87 @@
;
unexpected(this_file, "missing info in rtti_varmaps")
).
-maybe_check_type_info_var(typeclass_info(_, _), _, !VarMaps).
+maybe_check_type_info_var(typeclass_info(_, _), _, !RttiVarMaps).
-rtti_det_insert_typeclass_info_var(Constraint, ProgVar, !VarMaps) :-
- Map0 = !.VarMaps ^ tci_constraint_map,
+rtti_det_insert_typeclass_info_var(Constraint, ProgVar, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ rv_tci_constraint_map,
map.det_insert(Map0, ProgVar, Constraint, Map),
- !:VarMaps = !.VarMaps ^ tci_constraint_map := Map.
+ !RttiVarMaps ^ rv_tci_constraint_map := Map.
-rtti_set_typeclass_info_var(Constraint, ProgVar, !VarMaps) :-
- Map0 = !.VarMaps ^ tci_constraint_map,
+rtti_set_typeclass_info_var(Constraint, ProgVar, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ rv_tci_constraint_map,
map.set(Map0, ProgVar, Constraint, Map),
- !:VarMaps = !.VarMaps ^ tci_constraint_map := Map.
+ !RttiVarMaps ^ rv_tci_constraint_map := Map.
-rtti_reuse_typeclass_info_var(ProgVar, !VarMaps) :-
- ( map.search(!.VarMaps ^ tci_constraint_map, ProgVar, Constraint) ->
- Map0 = !.VarMaps ^ tci_varmap,
+rtti_reuse_typeclass_info_var(ProgVar, !RttiVarMaps) :-
+ ( map.search(!.RttiVarMaps ^ rv_tci_constraint_map, ProgVar, Constraint) ->
+ Map0 = !.RttiVarMaps ^ rv_tci_varmap,
map.set(Map0, Constraint, ProgVar, Map),
- !:VarMaps = !.VarMaps ^ tci_varmap := Map
+ !RttiVarMaps ^ rv_tci_varmap := Map
;
unexpected(this_file,
"rtti_reuse_typeclass_info_var: variable not known")
).
-rtti_det_insert_type_info_type(ProgVar, Type, !VarMaps) :-
- Map0 = !.VarMaps ^ ti_type_map,
+rtti_det_insert_type_info_type(ProgVar, Type, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ rv_ti_type_map,
map.det_insert(Map0, ProgVar, Type, Map),
- !:VarMaps = !.VarMaps ^ ti_type_map := Map.
+ !RttiVarMaps ^ rv_ti_type_map := Map.
-rtti_set_type_info_type(ProgVar, Type, !VarMaps) :-
- Map0 = !.VarMaps ^ ti_type_map,
+rtti_set_type_info_type(ProgVar, Type, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ rv_ti_type_map,
map.set(Map0, ProgVar, Type, Map),
- !:VarMaps = !.VarMaps ^ ti_type_map := Map.
+ !RttiVarMaps ^ rv_ti_type_map := Map.
-rtti_var_info_duplicate(Var, NewVar, !VarMaps) :-
- rtti_varmaps_var_info(!.VarMaps, Var, VarInfo),
+rtti_var_info_duplicate(Var, NewVar, !RttiVarMaps) :-
+ rtti_varmaps_var_info(!.RttiVarMaps, Var, VarInfo),
(
VarInfo = type_info_var(Type),
- rtti_det_insert_type_info_type(NewVar, Type, !VarMaps)
+ rtti_det_insert_type_info_type(NewVar, Type, !RttiVarMaps)
;
VarInfo = typeclass_info_var(Constraint),
- rtti_det_insert_typeclass_info_var(Constraint, NewVar, !VarMaps)
+ rtti_det_insert_typeclass_info_var(Constraint, NewVar, !RttiVarMaps)
;
VarInfo = non_rtti_var
).
-rtti_var_info_duplicate_replace(Var, NewVar, !VarMaps) :-
- rtti_varmaps_var_info(!.VarMaps, Var, VarInfo),
+rtti_var_info_duplicate_replace(Var, NewVar, !RttiVarMaps) :-
+ rtti_varmaps_var_info(!.RttiVarMaps, Var, VarInfo),
(
VarInfo = type_info_var(Type),
- rtti_set_type_info_type(NewVar, Type, !VarMaps)
+ rtti_set_type_info_type(NewVar, Type, !RttiVarMaps)
;
VarInfo = typeclass_info_var(Constraint),
- rtti_set_typeclass_info_var(Constraint, NewVar, !VarMaps)
+ rtti_set_typeclass_info_var(Constraint, NewVar, !RttiVarMaps)
;
VarInfo = non_rtti_var
).
-rtti_varmaps_tvars(VarMaps, TVars) :-
- map.keys(VarMaps ^ ti_varmap, TVars).
-
-rtti_varmaps_types(VarMaps, Types) :-
- solutions.solutions(rtti_varmaps_is_known_type(VarMaps), Types).
-
-:- pred rtti_varmaps_is_known_type(rtti_varmaps::in, mer_type::out) is nondet.
+rtti_varmaps_tvars(RttiVarMaps, TVars) :-
+ map.keys(RttiVarMaps ^ rv_ti_varmap, TVars).
-rtti_varmaps_is_known_type(VarMaps, Type) :-
- map.values(VarMaps ^ ti_type_map, Types),
- list.member(Type, Types).
-rtti_varmaps_is_known_type(VarMaps, Type) :-
- map.values(VarMaps ^ tci_constraint_map, Constraints),
- list.member(constraint(_, Types), Constraints),
- list.member(Type, Types).
-
-rtti_varmaps_reusable_constraints(VarMaps, Constraints) :-
- map.keys(VarMaps ^ tci_varmap, Constraints).
-
-rtti_varmaps_rtti_prog_vars(VarMaps, Vars) :-
- map.keys(VarMaps ^ ti_type_map, TIVars),
- map.keys(VarMaps ^ tci_constraint_map, TCIVars),
+rtti_varmaps_types(RttiVarMaps, Types) :-
+ TypeMap = RttiVarMaps ^ rv_ti_type_map,
+ ConstraintMap = RttiVarMaps ^ rv_tci_constraint_map,
+ TypeSet0 = set_tree234.init,
+ map.foldl_values(set_tree234.insert, TypeMap, TypeSet0, TypeSet1),
+ map.foldl_values(accumulate_types_in_prog_constraint, ConstraintMap,
+ TypeSet1, TypeSet),
+ Types = set_tree234.to_sorted_list(TypeSet).
+
+:- pred accumulate_types_in_prog_constraint(prog_constraint::in,
+ set_tree234(mer_type)::in, set_tree234(mer_type)::out) is det.
+
+accumulate_types_in_prog_constraint(Constraint, !TypeSet) :-
+ Constraint = constraint(_, ArgTypes),
+ set_tree234.insert_list(ArgTypes, !TypeSet).
+
+rtti_varmaps_reusable_constraints(RttiVarMaps, Constraints) :-
+ map.keys(RttiVarMaps ^ rv_tci_varmap, Constraints).
+
+rtti_varmaps_rtti_prog_vars(RttiVarMaps, Vars) :-
+ map.keys(RttiVarMaps ^ rv_ti_type_map, TIVars),
+ map.keys(RttiVarMaps ^ rv_tci_constraint_map, TCIVars),
list.append(TIVars, TCIVars, Vars).
apply_substitutions_to_rtti_varmaps(TRenaming, TSubst, Subst, !RttiVarMaps) :-
@@ -690,17 +785,17 @@
).
rtti_varmaps_transform_types(Pred, !RttiVarMaps) :-
- TciMap0 = !.RttiVarMaps ^ tci_varmap,
- TypeMap0 = !.RttiVarMaps ^ ti_type_map,
- ConstraintMap0 = !.RttiVarMaps ^ tci_constraint_map,
+ TciMap0 = !.RttiVarMaps ^ rv_tci_varmap,
+ TypeMap0 = !.RttiVarMaps ^ rv_ti_type_map,
+ ConstraintMap0 = !.RttiVarMaps ^ rv_tci_constraint_map,
map.foldl(apply_constraint_key_transformation(Pred), TciMap0,
map.init, TciMap),
map.map_values_only(Pred, TypeMap0, TypeMap),
map.map_values(apply_constraint_value_transformation(Pred),
ConstraintMap0, ConstraintMap),
- !:RttiVarMaps = !.RttiVarMaps ^ tci_varmap := TciMap,
- !:RttiVarMaps = !.RttiVarMaps ^ ti_type_map := TypeMap,
- !:RttiVarMaps = !.RttiVarMaps ^ tci_constraint_map := ConstraintMap.
+ !RttiVarMaps ^ rv_tci_varmap := TciMap,
+ !RttiVarMaps ^ rv_ti_type_map := TypeMap,
+ !RttiVarMaps ^ rv_tci_constraint_map := ConstraintMap.
:- pred apply_constraint_key_transformation(
pred(mer_type, mer_type)::in(pred(in, out) is det),
@@ -741,7 +836,7 @@
%-----------------------------------------------------------------------------%
get_typeinfo_vars(Vars, VarTypes, RttiVarMaps, TypeInfoVars) :-
- TVarMap = RttiVarMaps ^ ti_varmap,
+ TVarMap = RttiVarMaps ^ rv_ti_varmap,
set.to_sorted_list(Vars, VarList),
get_typeinfo_vars_2(VarList, VarTypes, TVarMap, TypeInfoVarList),
set.list_to_set(TypeInfoVarList, TypeInfoVars).
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.87
diff -u -b -r1.87 inst_match.m
--- compiler/inst_match.m 11 Jun 2009 07:00:10 -0000 1.87
+++ compiler/inst_match.m 15 Sep 2009 10:18:14 -0000
@@ -1362,21 +1362,21 @@
is semidet.
inst_is_ground(ModuleInfo, MaybeType, Inst) :-
- set.init(Expansions0),
+ Expansions0 = set_tree234.init,
inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already been expanded;
% we use this to avoid going into an infinite loop.
%
:- pred inst_is_ground_1(module_info::in, maybe(mer_type)::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
+ set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions) :-
- ( set.member(Inst, !.Expansions) ->
+ ( set_tree234.member(!.Expansions, Inst) ->
true
;
( Inst \= any(_, _) ->
- svset.insert(Inst, !Expansions)
+ set_tree234.insert(Inst, !Expansions)
;
true
),
@@ -1384,7 +1384,7 @@
).
:- pred inst_is_ground_2(module_info::in, maybe(mer_type)::in, mer_inst::in,
- set(mer_inst)::in, set(mer_inst)::out) is semidet.
+ set_tree234(mer_inst)::in, set_tree234(mer_inst)::out) is semidet.
inst_is_ground_2(_, _, not_reached, !Expansions).
inst_is_ground_2(ModuleInfo, MaybeType, bound(_, List), !Expansions) :-
@@ -1634,7 +1634,8 @@
%-----------------------------------------------------------------------------%
:- pred bound_inst_list_is_ground_2(list(bound_inst)::in, maybe(mer_type)::in,
- module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
+ module_info::in, set_tree234(mer_inst)::in, set_tree234(mer_inst)::out)
+ is semidet.
bound_inst_list_is_ground_2([], _, _, !Expansions).
bound_inst_list_is_ground_2([bound_functor(Name, Args) | BoundInsts],
@@ -1735,7 +1736,8 @@
%-----------------------------------------------------------------------------%
:- pred inst_list_is_ground_2(list(mer_inst)::in, list(maybe(mer_type))::in,
- module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
+ module_info::in, set_tree234(mer_inst)::in, set_tree234(mer_inst)::out)
+ is semidet.
inst_list_is_ground_2([], [], _, !Expansions).
inst_list_is_ground_2([], [_ | _], _, !Expansions) :-
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.141
diff -u -b -r1.141 lambda.m
--- compiler/lambda.m 8 Sep 2009 02:43:33 -0000 1.141
+++ compiler/lambda.m 16 Sep 2009 02:12:57 -0000
@@ -74,9 +74,9 @@
%-----------------------------------------------------------------------------%
-:- pred lambda_process_module(module_info::in, module_info::out) is det.
+:- pred expand_lambdas_in_module(module_info::in, module_info::out) is det.
-:- pred lambda_process_pred(pred_id::in, module_info::in, module_info::out)
+:- pred expand_lambdas_in_pred(pred_id::in, module_info::in, module_info::out)
is det.
%-----------------------------------------------------------------------------%
@@ -101,9 +101,13 @@
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
+:- import_module assoc_list.
+:- import_module array.
:- import_module bool.
+:- import_module int.
:- import_module list.
:- import_module map.
+:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module term.
@@ -123,8 +127,10 @@
pred_or_func,
string, % pred/func name
module_info,
- bool % true iff we need to recompute
+ bool, % true iff we need to recompute
% the nonlocals
+ bool % true if we expanded some lambda
+ % expressions
).
%-----------------------------------------------------------------------------%
@@ -132,27 +138,27 @@
% This whole section just traverses the module structure
%
-lambda_process_module(!ModuleInfo) :-
+expand_lambdas_in_module(!ModuleInfo) :-
module_info_predids(PredIds, !ModuleInfo),
- list.foldl(lambda_process_pred, PredIds, !ModuleInfo),
+ list.foldl(expand_lambdas_in_pred, PredIds, !ModuleInfo),
% Need update the dependency graph to include the lambda predicates.
module_info_clobber_dependency_info(!ModuleInfo).
-lambda_process_pred(PredId, !ModuleInfo) :-
+expand_lambdas_in_pred(PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
- list.foldl(lambda_process_proc(PredId), ProcIds, !ModuleInfo).
+ list.foldl(expand_lambdas_in_proc(PredId), ProcIds, !ModuleInfo).
-:- pred lambda_process_proc(pred_id::in, proc_id::in,
+:- pred expand_lambdas_in_proc(pred_id::in, proc_id::in,
module_info::in, module_info::out) is det.
-lambda_process_proc(PredId, ProcId, !ModuleInfo) :-
+expand_lambdas_in_proc(PredId, ProcId, !ModuleInfo) :-
module_info_preds(!.ModuleInfo, PredTable0),
map.lookup(PredTable0, PredId, PredInfo0),
pred_info_get_procedures(PredInfo0, ProcTable0),
map.lookup(ProcTable0, ProcId, ProcInfo0),
- lambda_process_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
+ expand_lambdas_in_proc_2(ProcInfo0, ProcInfo, PredInfo0, PredInfo1,
!ModuleInfo),
pred_info_get_procedures(PredInfo1, ProcTable1),
@@ -162,10 +168,10 @@
map.det_update(PredTable1, PredId, PredInfo, PredTable),
module_info_set_preds(PredTable, !ModuleInfo).
-:- pred lambda_process_proc_2(proc_info::in, proc_info::out,
+:- pred expand_lambdas_in_proc_2(proc_info::in, proc_info::out,
pred_info::in, pred_info::out, module_info::in, module_info::out) is det.
-lambda_process_proc_2(!ProcInfo, !PredInfo, !ModuleInfo) :-
+expand_lambdas_in_proc_2(!ProcInfo, !PredInfo, !ModuleInfo) :-
% Grab the appropriate fields from the pred_info and proc_info.
PredName = pred_info_name(!.PredInfo),
PredOrFunc = pred_info_is_pred_or_func(!.PredInfo),
@@ -179,31 +185,43 @@
proc_info_get_inst_varset(!.ProcInfo, InstVarSet0),
proc_info_get_has_parallel_conj(!.ProcInfo, HasParallelConj),
MustRecomputeNonLocals0 = no,
+ HaveExpandedLambdas0 = no,
% Process the goal.
- Info0 = lambda_info(VarSet0, VarTypes0, TypeVarSet0,
- InstVarSet0, RttiVarMaps0, Markers, HasParallelConj, PredOrFunc,
- PredName, !.ModuleInfo, MustRecomputeNonLocals0),
- lambda_process_goal(Goal0, Goal1, Info0, Info1),
- Info1 = lambda_info(VarSet1, VarTypes1, TypeVarSet,
- _, RttiVarMaps1, _, _, _, _, !:ModuleInfo, MustRecomputeNonLocals),
+ Info0 = lambda_info(VarSet0, VarTypes0, TypeVarSet0, InstVarSet0,
+ RttiVarMaps0, Markers, HasParallelConj, PredOrFunc,
+ PredName, !.ModuleInfo, MustRecomputeNonLocals0, HaveExpandedLambdas0),
+ expand_lambdas_in_goal(Goal0, Goal1, Info0, Info1),
+ Info1 = lambda_info(VarSet1, VarTypes1, TypeVarSet, _InstVarSet,
+ RttiVarMaps1, _, _, _, _, !:ModuleInfo, MustRecomputeNonLocals,
+ HaveExpandedLambdas),
% Check if we need to requantify.
(
MustRecomputeNonLocals = yes,
implicitly_quantify_clause_body_general(
- ordinary_nonlocals_maybe_lambda, HeadVars, _Warnings,
- Goal1, Goal2, VarSet1, VarSet, VarTypes1, VarTypes,
- RttiVarMaps1, RttiVarMaps),
+ ordinary_nonlocals_no_lambda, HeadVars, _Warnings,
+ Goal1, Goal2, VarSet1, VarSet2, VarTypes1, VarTypes2,
+ RttiVarMaps1, RttiVarMaps2),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
recompute_instmap_delta(recompute_atomic_instmap_deltas,
- Goal2, Goal, VarTypes, InstVarSet0, InstMap0, !ModuleInfo)
+ Goal2, Goal, VarTypes2, InstVarSet0, InstMap0, !ModuleInfo)
;
MustRecomputeNonLocals = no,
Goal = Goal1,
- VarSet = VarSet1,
- VarTypes = VarTypes1,
- RttiVarMaps = RttiVarMaps1
+ VarSet2 = VarSet1,
+ VarTypes2 = VarTypes1,
+ RttiVarMaps2 = RttiVarMaps1
+ ),
+ (
+ HaveExpandedLambdas = yes,
+ restrict_var_maps(HeadVars, Goal, VarSet2, VarSet, VarTypes2, VarTypes,
+ RttiVarMaps2, RttiVarMaps)
+ ;
+ HaveExpandedLambdas = no,
+ VarSet = VarSet2,
+ VarTypes = VarTypes2,
+ RttiVarMaps = RttiVarMaps2
),
% Set the new values of the fields in proc_info and pred_info.
@@ -213,33 +231,30 @@
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo).
- % The job of lambda_process_goal is to traverse the goal, processing each
- % unification with lambda_process_unify_goal.
- %
-:- pred lambda_process_goal(hlds_goal::in, hlds_goal::out,
+:- pred expand_lambdas_in_goal(hlds_goal::in, hlds_goal::out,
lambda_info::in, lambda_info::out) is det.
-lambda_process_goal(Goal0, Goal, !Info) :-
+expand_lambdas_in_goal(Goal0, Goal, !Info) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = unify(LHS, RHS, Mode, Unification, Context),
- lambda_process_unify_goal(LHS, RHS, Mode, Unification, Context,
+ expand_lambdas_in_unify_goal(LHS, RHS, Mode, Unification, Context,
GoalExpr, !Info)
;
GoalExpr0 = conj(ConjType, Goals0),
- lambda_process_goal_list(Goals0, Goals, !Info),
+ expand_lambdas_in_goal_list(Goals0, Goals, !Info),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
- lambda_process_goal_list(Goals0, Goals, !Info),
+ expand_lambdas_in_goal_list(Goals0, Goals, !Info),
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
- lambda_process_cases(Cases0, Cases, !Info),
+ expand_lambdas_in_cases(Cases0, Cases, !Info),
GoalExpr = switch(Var, CanFail, Cases)
;
GoalExpr0 = negation(SubGoal0),
- lambda_process_goal(SubGoal0, SubGoal, !Info),
+ expand_lambdas_in_goal(SubGoal0, SubGoal, !Info),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
@@ -248,14 +263,14 @@
% left its kind field as from_ground_term_construct.
GoalExpr = GoalExpr0
;
- lambda_process_goal(SubGoal0, SubGoal, !Info),
+ expand_lambdas_in_goal(SubGoal0, SubGoal, !Info),
GoalExpr = scope(Reason, SubGoal)
)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- lambda_process_goal(Cond0, Cond, !Info),
- lambda_process_goal(Then0, Then, !Info),
- lambda_process_goal(Else0, Else, !Info),
+ expand_lambdas_in_goal(Cond0, Cond, !Info),
+ expand_lambdas_in_goal(Then0, Then, !Info),
+ expand_lambdas_in_goal(Else0, Else, !Info),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
( GoalExpr0 = generic_call(_, _, _, _)
@@ -268,56 +283,56 @@
(
ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
MainGoal0, OrElseGoals0, OrElseInners),
- lambda_process_goal(MainGoal0, MainGoal, !Info),
- lambda_process_goal_list(OrElseGoals0, OrElseGoals, !Info),
+ expand_lambdas_in_goal(MainGoal0, MainGoal, !Info),
+ expand_lambdas_in_goal_list(OrElseGoals0, OrElseGoals, !Info),
ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars,
MainGoal, OrElseGoals, OrElseInners)
;
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
- lambda_process_goal(SubGoal0, SubGoal, !Info),
+ expand_lambdas_in_goal(SubGoal0, SubGoal, !Info),
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal)
;
ShortHand0 = bi_implication(_, _),
% These should have been expanded out by now.
- unexpected(this_file, "lambda_process_goal_2: bi_implication")
+ unexpected(this_file, "expand_lambdas_in_goal_2: bi_implication")
),
GoalExpr = shorthand(ShortHand)
),
Goal = hlds_goal(GoalExpr, GoalInfo).
-:- pred lambda_process_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred expand_lambdas_in_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
lambda_info::in, lambda_info::out) is det.
-lambda_process_goal_list([], [], !Info).
-lambda_process_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
- lambda_process_goal(Goal0, Goal, !Info),
- lambda_process_goal_list(Goals0, Goals, !Info).
+expand_lambdas_in_goal_list([], [], !Info).
+expand_lambdas_in_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
+ expand_lambdas_in_goal(Goal0, Goal, !Info),
+ expand_lambdas_in_goal_list(Goals0, Goals, !Info).
-:- pred lambda_process_cases(list(case)::in, list(case)::out,
+:- pred expand_lambdas_in_cases(list(case)::in, list(case)::out,
lambda_info::in, lambda_info::out) is det.
-lambda_process_cases([], [], !Info).
-lambda_process_cases([Case0 | Cases0], [Case | Cases], !Info) :-
+expand_lambdas_in_cases([], [], !Info).
+expand_lambdas_in_cases([Case0 | Cases0], [Case | Cases], !Info) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- lambda_process_goal(Goal0, Goal, !Info),
+ expand_lambdas_in_goal(Goal0, Goal, !Info),
Case = case(MainConsId, OtherConsIds, Goal),
- lambda_process_cases(Cases0, Cases, !Info).
+ expand_lambdas_in_cases(Cases0, Cases, !Info).
-:- pred lambda_process_unify_goal(prog_var::in, unify_rhs::in, unify_mode::in,
- unification::in, unify_context::in, hlds_goal_expr::out,
+:- pred expand_lambdas_in_unify_goal(prog_var::in, unify_rhs::in,
+ unify_mode::in, unification::in, unify_context::in, hlds_goal_expr::out,
lambda_info::in, lambda_info::out) is det.
-lambda_process_unify_goal(LHS, RHS0, Mode, Unification0, Context, GoalExpr,
+expand_lambdas_in_unify_goal(LHS, RHS0, Mode, Unification0, Context, GoalExpr,
!Info) :-
(
RHS0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
NonLocalVars, Vars, Modes, Det, LambdaGoal0),
% First, process the lambda goal recursively, in case it contains
% some nested lambda expressions.
- lambda_process_goal(LambdaGoal0, LambdaGoal, !Info),
+ expand_lambdas_in_goal(LambdaGoal0, LambdaGoal, !Info),
% Then, convert the lambda expression into a new predicate.
- lambda_process_lambda(Purity, Groundness, PredOrFunc, EvalMethod, Vars,
+ expand_lambda(Purity, Groundness, PredOrFunc, EvalMethod, Vars,
Modes, Det, NonLocalVars, LambdaGoal, Unification0, Y, Unification,
!Info),
GoalExpr = unify(LHS, Y, Mode, Unification, Context)
@@ -329,25 +344,25 @@
GoalExpr = unify(LHS, RHS0, Mode, Unification0, Context)
).
-:- pred lambda_process_lambda(purity::in, ho_groundness::in,
+:- pred expand_lambda(purity::in, ho_groundness::in,
pred_or_func::in, lambda_eval_method::in,
list(prog_var)::in, list(mer_mode)::in, determinism::in,
list(prog_var)::in, hlds_goal::in, unification::in, unify_rhs::out,
unification::out, lambda_info::in, lambda_info::out) is det.
-lambda_process_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, Vars, Modes,
+expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, Vars, Modes,
Detism, OrigNonLocals0, LambdaGoal, Unification0, Functor, Unification,
LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, TVarSet,
InstVarSet, RttiVarMaps, Markers, HasParallelConj, POF, OrigPredName,
- ModuleInfo0, MustRecomputeNonLocals0),
+ ModuleInfo0, MustRecomputeNonLocals0, _HaveExpandedLambdas),
% Calculate the constraints which apply to this lambda expression.
% Note currently we only allow lambda expressions to have universally
% quantified constraints.
rtti_varmaps_reusable_constraints(RttiVarMaps, AllConstraints),
- map.apply_to_list(Vars, VarTypes, LambdaVarTypes),
- list.map(type_vars, LambdaVarTypes, LambdaTypeVarsList),
+ map.apply_to_list(Vars, VarTypes, LambdaVarTypeList),
+ list.map(type_vars, LambdaVarTypeList, LambdaTypeVarsList),
list.condense(LambdaTypeVarsList, LambdaTypeVars),
list.filter(constraint_contains_vars(LambdaTypeVars),
AllConstraints, UnivConstraints),
@@ -371,7 +386,7 @@
; Unification0 = simple_test(_, _)
; Unification0 = complicated_unify(_, _, _)
),
- unexpected(this_file, "transform_lambda: weird unification")
+ unexpected(this_file, "expand_lambda: unexpected unification")
),
set.delete_list(LambdaGoalNonLocals, Vars, NonLocals1),
@@ -381,12 +396,12 @@
set.difference(ExtraTypeInfos, NonLocals1, NewTypeInfos),
set.union(NonLocals1, NewTypeInfos, NonLocals),
+ ( set.empty(NewTypeInfos) ->
+ MustRecomputeNonLocals = MustRecomputeNonLocals0
+ ;
% If we added variables to the nonlocals of the lambda goal, then
- % we need to recompute the nonlocals for the procedure that contains it.
- ( \+ set.empty(NewTypeInfos) ->
+ % we must recompute the nonlocals for the procedure that contains it.
MustRecomputeNonLocals = yes
- ;
- MustRecomputeNonLocals = MustRecomputeNonLocals0
),
set.to_sorted_list(NonLocals, ArgVars1),
@@ -403,14 +418,14 @@
% if all the inputs in the Yi precede the outputs. It's also not valid
% if any of the Xi are in the Yi.
- LambdaGoal = hlds_goal(plain_call(PredId0, ProcId0, CallVars, _, _, _),
- _),
+ LambdaGoal = hlds_goal(LambdaGoalExpr, _),
+ LambdaGoalExpr = plain_call(PredId0, ProcId0, CallVars, _, _, _),
module_info_pred_proc_info(ModuleInfo0, PredId0, ProcId0,
Call_PredInfo, Call_ProcInfo),
list.remove_suffix(CallVars, Vars, InitialVars),
- % check that none of the variables that we're trying to
- % use as curried arguments are lambda-bound variables
+ % Check that none of the variables that we're trying to use
+ % as curried arguments are lambda-bound variables.
\+ (
list.member(InitialVar, InitialVars),
list.member(InitialVar, Vars)
@@ -472,8 +487,7 @@
proc_info_set_address_taken(address_is_taken,
Call_ProcInfo, Call_NewProcInfo),
module_info_set_pred_proc_info(PredId, ProcId,
- Call_PredInfo, Call_NewProcInfo,
- ModuleInfo0, ModuleInfo)
+ Call_PredInfo, Call_NewProcInfo, ModuleInfo0, ModuleInfo)
;
% Prepare to create a new predicate for the lambda expression:
% work out the arguments, module name, predicate name, arity,
@@ -524,9 +538,11 @@
% Now construct the proc_info and pred_info for the new single-mode
% predicate, using the information computed above.
map.init(VarNameRemap),
- proc_info_create(LambdaContext, VarSet, VarTypes, AllArgVars,
- InstVarSet, AllArgModes, Detism, LambdaGoal, RttiVarMaps,
- address_is_taken, VarNameRemap, ProcInfo0),
+ restrict_var_maps(AllArgVars, LambdaGoal, VarSet, LambdaVarSet,
+ VarTypes, LambdaVarTypes, RttiVarMaps, LambdaRttiVarMaps),
+ proc_info_create(LambdaContext, LambdaVarSet, LambdaVarTypes,
+ AllArgVars, InstVarSet, AllArgModes, Detism, LambdaGoal,
+ LambdaRttiVarMaps, address_is_taken, VarNameRemap, ProcInfo0),
% The debugger ignores unnamed variables.
ensure_all_headvars_are_named(ProcInfo0, ProcInfo1),
@@ -568,9 +584,10 @@
Unification = construct(Var, ConsId, ArgVars, UniModes,
construct_dynamically, cell_is_unique, no_construct_sub_info),
+ HaveExpandedLambdas = yes,
LambdaInfo = lambda_info(VarSet, VarTypes, TVarSet,
InstVarSet, RttiVarMaps, Markers, HasParallelConj, POF, OrigPredName,
- ModuleInfo, MustRecomputeNonLocals).
+ ModuleInfo, MustRecomputeNonLocals, HaveExpandedLambdas).
:- pred constraint_contains_vars(list(tvar)::in, prog_constraint::in)
is semidet.
@@ -599,6 +616,223 @@
%---------------------------------------------------------------------------%
+ % The proc_info has several maps that refer to variables. After lambda
+ % expansion, both the newly created procedures and the original procedure
+ % that they were carved out of have duplicate copies of these maps.
+ % This duplication is a problem because later passes (in particular,
+ % the equiv_types_hlds pass) iterate over the entries in these maps,
+ % and if an entry is duplicated N times, they have to process it N times.
+ % The task of this predicate is to eliminate unnecessary entries
+ % from the vartypes map, and this requires also eliminating them from
+ % the rtti_varmaps.
+ %
+ % We could in theory restrict the varsets in the proc_info as well
+ % both the main prog_varset and the other varsets, e.g. the tvarset),
+ % but since we don't iterate over those sets, there is (as yet) no need
+ % for this.
+ %
+:- pred restrict_var_maps(list(prog_var)::in, hlds_goal::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+restrict_var_maps(HeadVars, Goal, !VarSet, !VarTypes, !RttiVarMaps) :-
+ MaxVar = varset.max_var(!.VarSet),
+ MaxVarNum = var_to_int(MaxVar),
+ % Variable numbers go from 1 to MaxVarNum. Reserve array slots
+ % from 0 to MaxVarNum, since wasting the space of one array element
+ % is preferable to having to always to do a subtraction on every array
+ % lookup.
+ array.init(MaxVarNum + 1, no, VarUses0),
+ mark_vars_as_used(HeadVars, VarUses0, VarUses1),
+ find_used_vars_in_goal(Goal, VarUses1, VarUses),
+
+ map.to_assoc_list(!.VarTypes, VarTypesList0),
+ filter_vartypes(VarTypesList0, [], RevVarTypesList, VarUses),
+ list.reverse(RevVarTypesList, VarTypesList),
+ map.from_sorted_assoc_list(VarTypesList, !:VarTypes),
+
+ restrict_rtti_varmaps(VarUses, !RttiVarMaps).
+
+:- pred filter_vartypes(assoc_list(prog_var, mer_type)::in,
+ assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out,
+ array(bool)::in) is det.
+
+filter_vartypes([], !RevVarTypes, _VarUses).
+filter_vartypes([VarType | VarTypes], !RevVarTypes, VarUses) :-
+ VarType = Var - _Type,
+ VarNum = var_to_int(Var),
+ array.unsafe_lookup(VarUses, VarNum, Used),
+ (
+ Used = yes,
+ !:RevVarTypes = [VarType | !.RevVarTypes]
+ ;
+ Used = no
+ ),
+ filter_vartypes(VarTypes, !RevVarTypes, VarUses).
+
+:- pred find_used_vars_in_goal(hlds_goal::in,
+ array(bool)::array_di, array(bool)::array_uo) is det.
+
+find_used_vars_in_goal(Goal, !VarUses) :-
+ Goal = hlds_goal(GoalExpr, _GoalInfo),
+ (
+ GoalExpr = unify(LHSVar, RHS, _, Unif, _),
+ mark_var_as_used(LHSVar, !VarUses),
+ (
+ Unif = construct(_, _, _, _, CellToReuse, _, _),
+ ( CellToReuse = reuse_cell(cell_to_reuse(ReuseVar, _, _)) ->
+ mark_var_as_used(ReuseVar, !VarUses)
+ ;
+ true
+ )
+ ;
+ Unif = deconstruct(_, _, _, _, _, _)
+ ;
+ Unif = assign(_, _)
+ ;
+ Unif = simple_test(_, _)
+ ;
+ Unif = complicated_unify(_, _, _)
+ ),
+ (
+ RHS = rhs_var(RHSVar),
+ mark_var_as_used(RHSVar, !VarUses)
+ ;
+ RHS = rhs_functor(_, _, ArgVars),
+ mark_vars_as_used(ArgVars, !VarUses)
+ ;
+ RHS = rhs_lambda_goal(_, _, _, _, NonLocals, LambdaVars,
+ _, _, LambdaGoal),
+ mark_vars_as_used(NonLocals, !VarUses),
+ mark_vars_as_used(LambdaVars, !VarUses),
+ find_used_vars_in_goal(LambdaGoal, !VarUses)
+ )
+ ;
+ GoalExpr = generic_call(GenericCall, ArgVars, _, _),
+ (
+ GenericCall = higher_order(Var, _, _, _),
+ mark_var_as_used(Var, !VarUses)
+ ;
+ GenericCall = class_method(Var, _, _, _),
+ mark_var_as_used(Var, !VarUses)
+ ;
+ GenericCall = event_call(_)
+ ;
+ GenericCall = cast(_)
+ ),
+ mark_vars_as_used(ArgVars, !VarUses)
+ ;
+ GoalExpr = plain_call(_, _, ArgVars, _, _, _),
+ mark_vars_as_used(ArgVars, !VarUses)
+ ;
+ ( GoalExpr = conj(_, Goals)
+ ; GoalExpr = disj(Goals)
+ ),
+ find_used_vars_in_goals(Goals, !VarUses)
+ ;
+ GoalExpr = switch(Var, _Det, Cases),
+ mark_var_as_used(Var, !VarUses),
+ find_used_vars_in_cases(Cases, !VarUses)
+ ;
+ GoalExpr = scope(Reason, SubGoal),
+ (
+ Reason = exist_quant(Vars),
+ mark_vars_as_used(Vars, !VarUses)
+ ;
+ Reason = promise_purity(_)
+ ;
+ Reason = promise_solutions(Vars, _),
+ mark_vars_as_used(Vars, !VarUses)
+ ;
+ Reason = barrier(_)
+ ;
+ Reason = commit(_)
+ ;
+ Reason = from_ground_term(Var, _),
+ mark_var_as_used(Var, !VarUses)
+ ;
+ Reason = trace_goal(_, _, _, _, _)
+ ),
+ find_used_vars_in_goal(SubGoal, !VarUses)
+ ;
+ GoalExpr = negation(SubGoal),
+ find_used_vars_in_goal(SubGoal, !VarUses)
+ ;
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ mark_vars_as_used(Vars, !VarUses),
+ find_used_vars_in_goal(Cond, !VarUses),
+ find_used_vars_in_goal(Then, !VarUses),
+ find_used_vars_in_goal(Else, !VarUses)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _),
+ ArgVars = list.map(foreign_arg_var, Args),
+ ExtraVars = list.map(foreign_arg_var, ExtraArgs),
+ mark_vars_as_used(ArgVars, !VarUses),
+ mark_vars_as_used(ExtraVars, !VarUses)
+ ;
+ GoalExpr = shorthand(Shorthand),
+ (
+ Shorthand = atomic_goal(_, Outer, Inner, MaybeOutputVars,
+ MainGoal, OrElseGoals, _),
+ Outer = atomic_interface_vars(OuterDI, OuterUO),
+ mark_var_as_used(OuterDI, !VarUses),
+ mark_var_as_used(OuterUO, !VarUses),
+ Inner = atomic_interface_vars(InnerDI, InnerUO),
+ mark_var_as_used(InnerDI, !VarUses),
+ mark_var_as_used(InnerUO, !VarUses),
+ (
+ MaybeOutputVars = no
+ ;
+ MaybeOutputVars = yes(OutputVars),
+ mark_vars_as_used(OutputVars, !VarUses)
+ ),
+ find_used_vars_in_goal(MainGoal, !VarUses),
+ find_used_vars_in_goals(OrElseGoals, !VarUses)
+ ;
+ Shorthand = try_goal(_, _, SubGoal),
+ % The IO and Result variables would be in SubGoal.
+ find_used_vars_in_goal(SubGoal, !VarUses)
+ ;
+ Shorthand = bi_implication(LeftGoal, RightGoal),
+ find_used_vars_in_goal(LeftGoal, !VarUses),
+ find_used_vars_in_goal(RightGoal, !VarUses)
+ )
+ ).
+
+:- pred find_used_vars_in_goals(list(hlds_goal)::in,
+ array(bool)::array_di, array(bool)::array_uo) is det.
+
+find_used_vars_in_goals([], !VarUses).
+find_used_vars_in_goals([Goal | Goals], !VarUses) :-
+ find_used_vars_in_goal(Goal, !VarUses),
+ find_used_vars_in_goals(Goals, !VarUses).
+
+:- pred find_used_vars_in_cases(list(case)::in,
+ array(bool)::array_di, array(bool)::array_uo) is det.
+
+find_used_vars_in_cases([], !VarUses).
+find_used_vars_in_cases([Case | Cases], !VarUses) :-
+ Case = case(_, _, Goal),
+ find_used_vars_in_goal(Goal, !VarUses),
+ find_used_vars_in_cases(Cases, !VarUses).
+
+:- pred mark_var_as_used(prog_var::in,
+ array(bool)::array_di, array(bool)::array_uo) is det.
+:- pragma inline(mark_var_as_used/3).
+
+mark_var_as_used(Var, !VarUses) :-
+ array.set(!.VarUses, var_to_int(Var), yes, !:VarUses).
+
+:- pred mark_vars_as_used(list(prog_var)::in,
+ array(bool)::array_di, array(bool)::array_uo) is det.
+
+mark_vars_as_used([], !VarUses).
+mark_vars_as_used([Var | Vars], !VarUses) :-
+ mark_var_as_used(Var, !VarUses),
+ mark_vars_as_used(Vars, !VarUses).
+
+%---------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "lambda.m".
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.502
diff -u -b -r1.502 mercury_compile.m
--- compiler/mercury_compile.m 2 Sep 2009 00:30:17 -0000 1.502
+++ compiler/mercury_compile.m 15 Sep 2009 04:08:15 -0000
@@ -3928,7 +3928,7 @@
process_lambdas(Verbose, Stats, !HLDS, !IO) :-
maybe_write_string(Verbose, "% Transforming lambda expressions...", !IO),
maybe_flush_output(Verbose, !IO),
- lambda_process_module(!HLDS),
+ expand_lambdas_in_module(!HLDS),
maybe_write_string(Verbose, " done.\n", !IO),
maybe_report_stats(Stats, !IO).
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.107
diff -u -b -r1.107 ml_elim_nested.m
--- compiler/ml_elim_nested.m 2 Sep 2009 05:48:00 -0000 1.107
+++ compiler/ml_elim_nested.m 14 Sep 2009 15:10:00 -0000
@@ -1677,16 +1677,6 @@
% For local variable definitions, if they are referenced by any nested
% functions, then strip them out and store them in the elim_info.
(
- % For IL and Java, we need to hoist all static constants out
- % to the top level, so that they can be initialized in the
- % class constructor. To keep things consistent (and reduce
- % the testing burden), we do the same for the other back-ends too.
- ml_decl_is_static_const(Defn0)
- ->
- elim_info_add_local_data(Defn0, !Info),
- Defns = [],
- InitStatements = []
- ;
% Hoist ordinary local variables.
Name = entity_data(DataName),
DataName = mlds_data_var(VarName),
@@ -1700,14 +1690,14 @@
( Init0 = init_obj(Rval) ->
% XXX Bug! Converting the initializer to an assignment doesn't
% work, because it doesn't handle the case when initializers in
- % FollowingDefns reference this variable
+ % FollowingDefns reference this variable.
Init1 = no_initializer,
DefnBody1 = mlds_data(Type, Init1, GCStatement0),
Defn1 = mlds_defn(Name, Context, Flags0, DefnBody1),
ModuleName = elim_info_get_module_name(!.Info),
VarLval = ml_var(qual(ModuleName, module_qual, VarName), Type),
- InitStatements = [statement(
- ml_stmt_atomic(assign(VarLval, Rval)), Context)]
+ InitStmt = ml_stmt_atomic(assign(VarLval, Rval)),
+ InitStatements = [statement(InitStmt, Context)]
;
Defn1 = Defn0,
InitStatements = []
@@ -1758,15 +1748,7 @@
FollowingDefns, FollowingStatements)
).
- % This checks for a nested function definition or static initializer
- % that references the variable. This is conservative; for the MLDS->C
- % and MLDS->GCC back-ends, we only need to hoist out static variables
- % if they are referenced by static initializers which themselves need to be
- % hoisted because they are referenced from a nested function. But checking
- % the last part of that is tricky, and for the Java and IL back-ends we
- % need to hoist out all static constants anyway, so to keep things simple
- % we do the same for the C back-end to, i.e. we always hoist all static
- % constants.
+ % This checks for a nested function definition.
%
% XXX Do we need to check for references from the GCStatement
% fields here?
@@ -1777,23 +1759,22 @@
:- pred ml_need_to_hoist(mlds_module_name::in, mlds_data_name::in,
list(mlds_defn)::in, list(statement)::in) is semidet.
-ml_need_to_hoist(ModuleName, DataName,
- FollowingDefns, FollowingStatements) :-
+ml_need_to_hoist(ModuleName, DataName, FollowingDefns, FollowingStatements) :-
QualDataName = qual(ModuleName, module_qual, DataName),
+ Filter = ml_need_to_hoist_defn(QualDataName),
(
- list.member(FollowingDefn, FollowingDefns)
+ list.find_first_match(Filter, FollowingDefns, _)
;
- statements_contains_defn(FollowingStatements, FollowingDefn)
- ),
- (
- FollowingDefn = mlds_defn(_, _, _, mlds_function(_, _, _, _, _)),
- defn_contains_var(FollowingDefn, QualDataName)
- ;
- FollowingDefn = mlds_defn(_, _, _, mlds_data(_, Initializer, _)),
- ml_decl_is_static_const(FollowingDefn),
- initializer_contains_var(Initializer, QualDataName)
+ statements_contains_matching_defn(Filter, FollowingStatements)
).
+:- pred ml_need_to_hoist_defn(mlds_fully_qualified_name(mlds_data_name)::in,
+ mlds_defn::in) is semidet.
+
+ml_need_to_hoist_defn(QualDataName, FollowingDefn) :-
+ FollowingDefn = mlds_defn(_, _, _, mlds_function(_, _, _, _, _)),
+ defn_contains_var(FollowingDefn, QualDataName).
+
%-----------------------------------------------------------------------------%
% fixup_initializers:
@@ -2246,94 +2227,59 @@
%-----------------------------------------------------------------------------%
%
-% defns_contains_defn:
-% defn_contains_defn:
-% defn_body_contains_defn:
-% maybe_statement_contains_defn:
-% function_body_contains_defn:
-% statements_contains_defn:
-% statement_contains_defn:
+% Succeed if the specified construct contains a definition for which the
+% given filter predicate succeeds.
%
-% Nondeterministically return all the definitions contained
-% in the specified construct.
-:- pred defns_contains_defn(list(mlds_defn)::in, mlds_defn::out) is nondet.
+:- pred statements_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), list(statement)::in) is semidet.
-defns_contains_defn(Defns, Name) :-
- list.member(Defn, Defns),
- defn_contains_defn(Defn, Name).
-
-:- pred defn_contains_defn(mlds_defn::in, mlds_defn::out) is multi.
-
-defn_contains_defn(Defn, Defn). /* this is where we succeed! */
-defn_contains_defn(mlds_defn(_Name, _Context, _Flags, DefnBody), Defn) :-
- defn_body_contains_defn(DefnBody, Defn).
-
-:- pred defn_body_contains_defn(mlds_entity_defn::in, mlds_defn::out)
- is nondet.
-
-% defn_body_contains_defn(mlds_data(_Type, _Initializer, _), _Defn) :- fail.
-defn_body_contains_defn(mlds_function(_PredProcId, _Params, FunctionBody,
- _Attrs, _EnvVarNames), Name) :-
- function_body_contains_defn(FunctionBody, Name).
-defn_body_contains_defn(mlds_class(ClassDefn), Name) :-
- ClassDefn = mlds_class_defn(_Kind, _Imports, _Inherits, _Implements,
- CtorDefns, FieldDefns),
- ( defns_contains_defn(FieldDefns, Name)
- ; defns_contains_defn(CtorDefns, Name)
+statements_contains_matching_defn(Filter, [Statement | Statements]) :-
+ (
+ statement_contains_matching_defn(Filter, Statement)
+ ;
+ statements_contains_matching_defn(Filter, Statements)
).
-:- pred statements_contains_defn(list(statement)::in, mlds_defn::out) is nondet.
-
-statements_contains_defn(Statements, Defn) :-
- list.member(Statement, Statements),
- statement_contains_defn(Statement, Defn).
-
-:- pred maybe_statement_contains_defn(maybe(statement)::in,
- mlds_defn::out) is nondet.
-
-% maybe_statement_contains_defn(no, _Defn) :- fail.
-maybe_statement_contains_defn(yes(Statement), Defn) :-
- statement_contains_defn(Statement, Defn).
-
-:- pred function_body_contains_defn(mlds_function_body::in, mlds_defn::out)
- is nondet.
+:- pred maybe_statement_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), maybe(statement)::in) is semidet.
-% function_body_contains_defn(body_external, _Defn) :- fail.
-function_body_contains_defn(body_defined_here(Statement), Defn) :-
- statement_contains_defn(Statement, Defn).
+maybe_statement_contains_matching_defn(Filter, yes(Statement)) :-
+ statement_contains_matching_defn(Filter, Statement).
-:- pred statement_contains_defn(statement::in, mlds_defn::out) is nondet.
+:- pred statement_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), statement::in) is semidet.
-statement_contains_defn(Statement, Defn) :-
+statement_contains_matching_defn(Filter, Statement) :-
Statement = statement(Stmt, _Context),
- stmt_contains_defn(Stmt, Defn).
+ stmt_contains_matching_defn(Filter, Stmt).
-:- pred stmt_contains_defn(mlds_stmt::in, mlds_defn::out) is nondet.
+:- pred stmt_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), mlds_stmt::in) is semidet.
-stmt_contains_defn(Stmt, Defn) :-
+stmt_contains_matching_defn(Filter, Stmt) :-
(
Stmt = ml_stmt_block(Defns, Statements),
- ( defns_contains_defn(Defns, Defn)
- ; statements_contains_defn(Statements, Defn)
+ ( defns_contains_matching_defn(Filter, Defns)
+ ; statements_contains_matching_defn(Filter, Statements)
)
;
Stmt = ml_stmt_while(_Rval, Statement, _Once),
- statement_contains_defn(Statement, Defn)
+ statement_contains_matching_defn(Filter, Statement)
;
Stmt = ml_stmt_if_then_else(_Cond, Then, MaybeElse),
- ( statement_contains_defn(Then, Defn)
- ; maybe_statement_contains_defn(MaybeElse, Defn)
+ ( statement_contains_matching_defn(Filter, Then)
+ ; maybe_statement_contains_matching_defn(Filter, MaybeElse)
)
;
Stmt = ml_stmt_switch(_Type, _Val, _Range, Cases, Default),
- ( cases_contains_defn(Cases, Defn)
- ; default_contains_defn(Default, Defn)
+ ( cases_contains_matching_defn(Filter, Cases)
+ ; default_contains_matching_defn(Filter, Default)
)
;
Stmt = ml_stmt_try_commit(_Ref, Statement, Handler),
- ( statement_contains_defn(Statement, Defn)
- ; statement_contains_defn(Handler, Defn)
+ ( statement_contains_matching_defn(Filter, Statement)
+ ; statement_contains_matching_defn(Filter, Handler)
)
;
( Stmt = ml_stmt_label(_Label)
@@ -2347,21 +2293,67 @@
fail
).
-:- pred cases_contains_defn(list(mlds_switch_case)::in, mlds_defn::out)
- is nondet.
+:- pred cases_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), list(mlds_switch_case)::in)
+ is semidet.
-cases_contains_defn(Cases, Defn) :-
- list.member(Case, Cases),
+cases_contains_matching_defn(Filter, [Case | Cases]) :-
+ (
+ case_contains_matching_defn(Filter, Case)
+ ;
+ cases_contains_matching_defn(Filter, Cases)
+ ).
+
+:- pred case_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), mlds_switch_case::in) is semidet.
+
+case_contains_matching_defn(Filter, Case) :-
Case = mlds_switch_case(_FirstMatchCond, _LaterMatchConds, Statement),
- statement_contains_defn(Statement, Defn).
+ statement_contains_matching_defn(Filter, Statement).
+
+:- pred default_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), mlds_switch_default::in)
+ is semidet.
+
+% default_contains_matching_defn(_, default_do_nothing) :- fail.
+% default_contains_matching_defn(_, default_is_unreachable) :- fail.
+default_contains_matching_defn(Filter, default_case(Statement)) :-
+ statement_contains_matching_defn(Filter, Statement).
+
+:- pred defns_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), list(mlds_defn)::in) is semidet.
+
+defns_contains_matching_defn(Filter, [Defn | Defns]) :-
+ (
+ defn_contains_matching_defn(Filter, Defn)
+ ;
+ defns_contains_matching_defn(Filter, Defns)
+ ).
-:- pred default_contains_defn(mlds_switch_default::in, mlds_defn::out)
- is nondet.
+:- pred defn_contains_matching_defn(
+ pred(mlds_defn)::in(pred(in) is semidet), mlds_defn::in) is semidet.
-% default_contains_defn(default_do_nothing, _) :- fail.
-% default_contains_defn(default_is_unreachable, _) :- fail.
-default_contains_defn(default_case(Statement), Defn) :-
- statement_contains_defn(Statement, Defn).
+defn_contains_matching_defn(Filter, Defn) :-
+ (
+ Filter(Defn) % This is where we succeed!
+ ;
+ Defn = mlds_defn(_Name, _Context, _Flags, DefnBody),
+ (
+ DefnBody = mlds_function(_PredProcId, _Params, FunctionBody,
+ _Attrs, _EnvVarNames),
+ FunctionBody = body_defined_here(Statement),
+ statement_contains_matching_defn(Filter, Statement)
+ ;
+ DefnBody = mlds_class(ClassDefn),
+ ClassDefn = mlds_class_defn(_Kind, _Imports, _Inherits,
+ _Implements, CtorDefns, FieldDefns),
+ (
+ defns_contains_matching_defn(Filter, FieldDefns)
+ ;
+ defns_contains_matching_defn(Filter, CtorDefns)
+ )
+ )
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.59
diff -u -b -r1.59 ml_optimize.m
--- compiler/ml_optimize.m 2 Sep 2009 05:48:00 -0000 1.59
+++ compiler/ml_optimize.m 14 Sep 2009 15:15:53 -0000
@@ -620,17 +620,19 @@
LHS = ml_var(ThisVar, _ThisType),
ThisVar = qual(Qualifier, QualKind, VarName),
ThisData = qual(Qualifier, QualKind, mlds_data_var(VarName)),
- Qualifier = OptInfo ^ oi_module_name,
- list.takewhile(isnt(var_defn(VarName)), !.Defns,
- _PrecedingDefns, [_VarDefn | FollowingDefns]),
% We must check that the value being assigned doesn't refer to the
- % variable itself, or to any of the variables which are declared
- % after this one. We must also check that the initializers (if any)
- % of the variables that follow this one don't refer to this variable.
+ % variable itself.
\+ rval_contains_var(RHS, ThisData),
- \+ (
- list.member(OtherDefn, FollowingDefns),
+
+ % We must check that the value being assign doesn't refer to any
+ % of the variables which are declared after this one. We must also
+ % check that the initializers (if any) of the variables that follow
+ % this one don't refer to this variable.
+ Qualifier = OptInfo ^ oi_module_name,
+ list.takewhile(isnt(var_defn(VarName)), !.Defns,
+ _PrecedingDefns, [_VarDefn | FollowingDefns]),
+ Filter = (pred(OtherDefn::in) is semidet :-
OtherDefn = mlds_defn(entity_data(OtherVarName),
_, _, mlds_data(_Type, OtherInitializer, _GC)),
(
@@ -638,7 +640,8 @@
;
initializer_contains_var(OtherInitializer, ThisData)
)
- )
+ ),
+ \+ list.find_first_match(Filter, FollowingDefns, _)
->
% Replace the assignment statement with an initializer
% on the variable declaration.
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.130
diff -u -b -r1.130 modecheck_unify.m
--- compiler/modecheck_unify.m 3 Sep 2009 23:57:27 -0000 1.130
+++ compiler/modecheck_unify.m 15 Sep 2009 10:00:56 -0000
@@ -1392,8 +1392,11 @@
% For existentially quantified data types, check that any type_info
% or type_class_info variables in the construction are ground.
- check_type_info_args_are_ground(ArgVars, VarTypes,
- UnifyContext, !ModeInfo)
+ mode_info_set_call_context(call_context_unify(UnifyContext),
+ !ModeInfo),
+ check_type_info_args_are_ground(ArgVars, VarTypes, UnifyContext,
+ !ModeInfo),
+ mode_info_unset_call_context(!ModeInfo)
;
% It is a deconstruction.
(
@@ -1442,8 +1445,7 @@
% in the argument list are ground.
%
:- pred check_type_info_args_are_ground(list(prog_var)::in,
- vartypes::in, unify_context::in,
- mode_info::in, mode_info::out) is det.
+ vartypes::in, unify_context::in, mode_info::in, mode_info::out) is det.
check_type_info_args_are_ground([], _VarTypes, _UnifyContext, !ModeInfo).
check_type_info_args_are_ground([ArgVar | ArgVars], VarTypes, UnifyContext,
@@ -1452,14 +1454,11 @@
map.lookup(VarTypes, ArgVar, ArgType),
is_introduced_type_info_type(ArgType)
->
- mode_info_set_call_context(call_context_unify(UnifyContext),
- !ModeInfo),
- InitialArgNum = 0,
- modecheck_var_has_inst_list_no_exact_match([ArgVar],
- [ground(shared, none)], InitialArgNum, _InstVarSub, !ModeInfo),
+ mode_info_set_call_arg_context(1, !ModeInfo),
+ modecheck_introduced_type_info_var_has_inst_no_exact_match(ArgVar,
+ ArgType, ground(shared, none), !ModeInfo),
check_type_info_args_are_ground(ArgVars, VarTypes, UnifyContext,
- !ModeInfo),
- mode_info_unset_call_context(!ModeInfo)
+ !ModeInfo)
;
true
).
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.385
diff -u -b -r1.385 modes.m
--- compiler/modes.m 8 Sep 2009 02:43:34 -0000 1.385
+++ compiler/modes.m 15 Sep 2009 10:02:01 -0000
@@ -233,6 +233,14 @@
list(mer_inst)::in, int::in, inst_var_sub::out,
mode_info::in, mode_info::out) is det.
+ % This is a special-cased, cut-down version of
+ % modecheck_var_has_inst_list_no_exact_match for use specifically
+ % on introduced type_info_type variables.
+ %
+:- pred modecheck_introduced_type_info_var_has_inst_no_exact_match(
+ prog_var::in, mer_type::in, mer_inst::in,
+ mode_info::in, mode_info::out) is det.
+
% modecheck_set_var_inst(Var, Inst, MaybeUInst, !ModeInfo):
%
% Assign the given Inst to the given Var, after checking that it is
@@ -3739,11 +3747,11 @@
inst_var_sub::in, inst_var_sub::out,
mode_info::in, mode_info::out) is det.
-modecheck_var_has_inst_exact_match(VarId, Inst, !Subst, !ModeInfo) :-
+modecheck_var_has_inst_exact_match(Var, Inst, !Subst, !ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap_lookup_var(InstMap, VarId, VarInst),
+ instmap_lookup_var(InstMap, Var, VarInst),
mode_info_get_var_types(!.ModeInfo, VarTypes),
- map.lookup(VarTypes, VarId, Type),
+ map.lookup(VarTypes, Var, Type),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
(
inst_matches_initial_no_implied_modes_sub(VarInst, Inst, Type,
@@ -3751,20 +3759,20 @@
->
mode_info_set_module_info(ModuleInfo, !ModeInfo)
;
- set.singleton_set(WaitingVars, VarId),
+ set.singleton_set(WaitingVars, Var),
mode_info_error(WaitingVars,
- mode_error_var_has_inst(VarId, VarInst, Inst), !ModeInfo)
+ mode_error_var_has_inst(Var, VarInst, Inst), !ModeInfo)
).
:- pred modecheck_var_has_inst_no_exact_match(prog_var::in, mer_inst::in,
inst_var_sub::in, inst_var_sub::out,
mode_info::in, mode_info::out) is det.
-modecheck_var_has_inst_no_exact_match(VarId, Inst, !Subst, !ModeInfo) :-
+modecheck_var_has_inst_no_exact_match(Var, Inst, !Subst, !ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap),
- instmap_lookup_var(InstMap, VarId, VarInst),
+ instmap_lookup_var(InstMap, Var, VarInst),
mode_info_get_var_types(!.ModeInfo, VarTypes),
- map.lookup(VarTypes, VarId, Type),
+ map.lookup(VarTypes, Var, Type),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
(
inst_matches_initial_sub(VarInst, Inst, Type, ModuleInfo0, ModuleInfo,
@@ -3772,9 +3780,25 @@
->
mode_info_set_module_info(ModuleInfo, !ModeInfo)
;
- set.singleton_set(WaitingVars, VarId),
+ set.singleton_set(WaitingVars, Var),
+ mode_info_error(WaitingVars,
+ mode_error_var_has_inst(Var, VarInst, Inst), !ModeInfo)
+ ).
+
+modecheck_introduced_type_info_var_has_inst_no_exact_match(Var, Type, Inst,
+ !ModeInfo) :-
+ mode_info_get_instmap(!.ModeInfo, InstMap),
+ instmap_lookup_var(InstMap, Var, VarInst),
+ mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
+ (
+ inst_matches_initial_sub(VarInst, Inst, Type, ModuleInfo0, ModuleInfo,
+ map.init, _Subst)
+ ->
+ mode_info_set_module_info(ModuleInfo, !ModeInfo)
+ ;
+ set.singleton_set(WaitingVars, Var),
mode_info_error(WaitingVars,
- mode_error_var_has_inst(VarId, VarInst, Inst), !ModeInfo)
+ mode_error_var_has_inst(Var, VarInst, Inst), !ModeInfo)
).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.346
diff -u -b -r1.346 polymorphism.m
--- compiler/polymorphism.m 14 Sep 2009 03:38:40 -0000 1.346
+++ compiler/polymorphism.m 16 Sep 2009 02:21:33 -0000
@@ -616,7 +616,7 @@
Goal0 = !.Clause ^ clause_body,
% Process any polymorphic calls inside the goal.
- poly_info_set_type_info_var_map(map.init, !Info),
+ empty_maps(!Info),
poly_info_set_num_reuses(0, !Info),
polymorphism_process_goal(Goal0, Goal1, !Info),
@@ -1102,37 +1102,35 @@
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
- polymorphism_process_disj(Goals0, Goals, InitialTypeInfoVarMap,
- !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ get_maps_snapshot(!.Info, InitialSnapshot),
+ polymorphism_process_disj(Goals0, Goals, InitialSnapshot, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
GoalExpr = disj(Goals)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
+ get_maps_snapshot(!.Info, InitialSnapshot),
polymorphism_process_goal(Cond0, Cond, !Info),
% If we allowed a type_info created inside Cond to be reused
% in Then, then we are adding an output variable to Cond.
% If Cond scope had no outputs to begin with, this would change
% its determinism.
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
polymorphism_process_goal(Then0, Then, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
polymorphism_process_goal(Else0, Else, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(SubGoal0),
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
+ get_maps_snapshot(!.Info, InitialSnapshot),
polymorphism_process_goal(SubGoal0, SubGoal, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
- polymorphism_process_cases(Cases0, Cases, InitialTypeInfoVarMap,
- !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ get_maps_snapshot(!.Info, InitialSnapshot),
+ polymorphism_process_cases(Cases0, Cases, InitialSnapshot, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
GoalExpr = switch(Var, CanFail, Cases)
;
GoalExpr0 = scope(Reason0, SubGoal0),
@@ -1167,9 +1165,9 @@
% However, using a type_info from before the scope in SubGoal
% is perfectly ok.
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
+ get_maps_snapshot(!.Info, InitialSnapshot),
polymorphism_process_goal(SubGoal0, SubGoal, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
Reason = Reason0
;
Reason0 = trace_goal(_, _, _, _, _),
@@ -1183,9 +1181,9 @@
% whether the deletion will happen or not, but doing so would
% require breaching the separation between compiler passes.
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
+ get_maps_snapshot(!.Info, InitialSnapshot),
polymorphism_process_goal(SubGoal0, SubGoal, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
Reason = Reason0
),
GoalExpr = scope(Reason, SubGoal)
@@ -1196,11 +1194,11 @@
(
ShortHand0 = atomic_goal(GoalType, Outer, Inner, Vars,
MainGoal0, OrElseGoals0, OrElseInners),
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
+ get_maps_snapshot(!.Info, InitialSnapshot),
polymorphism_process_goal(MainGoal0, MainGoal, !Info),
polymorphism_process_disj(OrElseGoals0, OrElseGoals,
- InitialTypeInfoVarMap, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ InitialSnapshot, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
ShortHand = atomic_goal(GoalType, Outer, Inner, Vars,
MainGoal, OrElseGoals, OrElseInners)
;
@@ -1210,16 +1208,17 @@
% expressions; because those pieces of code will end up
% in different procedures. However, for try goals, this is true
% even for the first and second conjuncts.
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
+ get_maps_snapshot(!.Info, InitialSnapshot),
(
SubGoal0 = hlds_goal(SubGoalExpr0, SubGoalInfo),
SubGoalExpr0 = conj(plain_conj, Conjuncts0),
Conjuncts0 = [ConjunctA0, ConjunctB0]
->
- poly_info_set_type_info_var_map(map.init, !Info),
+ empty_maps(!Info),
polymorphism_process_goal(ConjunctA0, ConjunctA, !Info),
- poly_info_set_type_info_var_map(map.init, !Info),
+ empty_maps(!Info),
polymorphism_process_goal(ConjunctB0, ConjunctB, !Info),
+
Conjuncts = [ConjunctA, ConjunctB],
SubGoalExpr = conj(plain_conj, Conjuncts),
SubGoal = hlds_goal(SubGoalExpr, SubGoalInfo)
@@ -1227,7 +1226,7 @@
unexpected(this_file,
"polymorphism_process_goal_expr: malformed try goal")
),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal)
;
ShortHand0 = bi_implication(_, _),
@@ -1287,7 +1286,7 @@
SubGoal = SubGoal1
)
;
- % We did introduced some variables into the scope, so we cannot
+ % We did introduce some variables into the scope, so we cannot
% guarantee that the scope still satisfies the invariants of
% from_ground_term_construct scopes.
Reason = from_ground_term(TermVar, from_ground_term_other),
@@ -1369,10 +1368,10 @@
% This is because, after lambda expansion, the code inside and outside
% the lambda goal will end up in different procedures.
- poly_info_get_type_info_var_map(!.Info, InitialTypeInfoVarMap),
- poly_info_set_type_info_var_map(map.init, !Info),
+ get_maps_snapshot(!.Info, InitialSnapshot),
+ empty_maps(!Info),
polymorphism_process_goal(LambdaGoal0, LambdaGoal1, !Info),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
% Currently we don't allow lambda goals to be existentially typed.
ExistQVars = [],
@@ -1951,26 +1950,26 @@
polymorphism_process_conj(Goals0, Goals, !Info).
:- pred polymorphism_process_disj(list(hlds_goal)::in, list(hlds_goal)::out,
- type_info_var_map::in, poly_info::in, poly_info::out) is det.
+ maps_snapshot::in, poly_info::in, poly_info::out) is det.
polymorphism_process_disj([], [], _, !Info).
-polymorphism_process_disj([Goal0 | Goals0], [Goal | Goals],
- InitialTypeInfoVarMap, !Info) :-
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+polymorphism_process_disj([Goal0 | Goals0], [Goal | Goals], InitialSnapshot,
+ !Info) :-
+ set_maps_snapshot(InitialSnapshot, !Info),
polymorphism_process_goal(Goal0, Goal, !Info),
- polymorphism_process_disj(Goals0, Goals, InitialTypeInfoVarMap, !Info).
+ polymorphism_process_disj(Goals0, Goals, InitialSnapshot, !Info).
:- pred polymorphism_process_cases(list(case)::in, list(case)::out,
- type_info_var_map::in, poly_info::in, poly_info::out) is det.
+ maps_snapshot::in, poly_info::in, poly_info::out) is det.
polymorphism_process_cases([], [], _, !Info).
-polymorphism_process_cases([Case0 | Cases0], [Case | Cases],
- InitialTypeInfoVarMap, !Info) :-
+polymorphism_process_cases([Case0 | Cases0], [Case | Cases], InitialSnapshot,
+ !Info) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
- poly_info_set_type_info_var_map(InitialTypeInfoVarMap, !Info),
+ set_maps_snapshot(InitialSnapshot, !Info),
polymorphism_process_goal(Goal0, Goal, !Info),
Case = case(MainConsId, OtherConsIds, Goal),
- polymorphism_process_cases(Cases0, Cases, InitialTypeInfoVarMap, !Info).
+ polymorphism_process_cases(Cases0, Cases, InitialSnapshot, !Info).
%-----------------------------------------------------------------------------%
@@ -2223,7 +2222,7 @@
% or the arguments of existentially typed predicate calls, function calls
% and deconstruction unifications.
%
- % Type(class)-infos added for ground types added to predicate calls,
+ % Type(class)-infos added for ground types passed to predicate calls,
% function calls and existentially typed construction unifications
% do not require requantification because they are local to the conjunction
% containing the type(class)-info construction and the goal which uses the
@@ -2309,53 +2308,45 @@
list(prog_var)::out, list(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
-make_typeclass_info_vars(Constraints, ExistQVars, Context,
- ExtraVars, ExtraGoals, !Info) :-
- % Initialise the accumulators
- RevExtraVars0 = [],
- RevExtraGoals0 = [],
+make_typeclass_info_vars(Constraints, ExistQVars, Context, TypeClassInfoVars,
+ ExtraGoals, !Info) :-
SeenInstances = [],
- % Do the work.
- make_typeclass_info_vars_2(Constraints, SeenInstances,
- ExistQVars, Context, RevExtraVars0, RevExtraVars,
- RevExtraGoals0, RevExtraGoals, !Info),
- % We build up the vars and goals in reverse order.
- list.reverse(RevExtraVars, ExtraVars),
- list.reverse(RevExtraGoals, ExtraGoals).
+ make_typeclass_info_vars_2(Constraints, SeenInstances, ExistQVars, Context,
+ TypeClassInfoVars, cord.empty, ExtraGoalsCord, !Info),
+ ExtraGoals = cord.list(ExtraGoalsCord).
% Accumulator version of the above.
%
:- pred make_typeclass_info_vars_2(list(prog_constraint)::in,
list(prog_constraint)::in, existq_tvars::in, prog_context::in,
- list(prog_var)::in, list(prog_var)::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
+ list(prog_var)::out, cord(hlds_goal)::in, cord(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
-make_typeclass_info_vars_2([], _Seen, _ExistQVars,
- _Context, !ExtraVars, !ExtraGoals, !Info).
-make_typeclass_info_vars_2([Constraint | Constraints],
- Seen, ExistQVars, Context, !ExtraVars, !ExtraGoals, !Info) :-
+make_typeclass_info_vars_2([], _Seen, _ExistQVars, _Context,
+ [], !ExtraGoals, !Info).
+make_typeclass_info_vars_2([Constraint | Constraints], Seen, ExistQVars,
+ Context, [TypeClassInfoVar | TypeClassInfoVars], !ExtraGoals, !Info) :-
make_typeclass_info_var(Constraint, [Constraint | Seen],
- ExistQVars, Context, !ExtraGoals, !Info, MaybeExtraVar),
- maybe_insert_var(MaybeExtraVar, !ExtraVars),
+ ExistQVars, Context, TypeClassInfoVar, !ExtraGoals, !Info),
make_typeclass_info_vars_2(Constraints, Seen, ExistQVars,
- Context, !ExtraVars, !ExtraGoals, !Info).
+ Context, TypeClassInfoVars, !ExtraGoals, !Info).
:- pred make_typeclass_info_var(prog_constraint::in,
list(prog_constraint)::in, existq_tvars::in, prog_context::in,
- list(hlds_goal)::in, list(hlds_goal)::out,
- poly_info::in, poly_info::out, maybe(prog_var)::out) is det.
+ prog_var::out, cord(hlds_goal)::in, cord(hlds_goal)::out,
+ poly_info::in, poly_info::out) is det.
-make_typeclass_info_var(Constraint, Seen, ExistQVars,
- Context, !ExtraGoals, !Info, MaybeVar) :-
+make_typeclass_info_var(Constraint, Seen, ExistQVars, Context,
+ TypeClassInfoVar, !ExtraGoals, !Info) :-
(
- rtti_search_typeclass_info_var(!.Info ^ poly_rtti_varmaps, Constraint,
- Var)
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ rtti_search_typeclass_info_var(RttiVarMaps0, Constraint,
+ OldTypeClassInfoVar)
->
% We already have a typeclass_info for this constraint, either from
% a parameter to the pred or from an existentially quantified goal
% that we have already processed.
- MaybeVar = yes(Var)
+ TypeClassInfoVar = OldTypeClassInfoVar
;
% We don't have the typeclass_info, we must either have a proof that
% tells us how to make it, or it will be produced by an existentially
@@ -2363,55 +2354,52 @@
map.search(!.Info ^ poly_proof_map, Constraint, Proof)
->
make_typeclass_info_from_proof(Constraint, Seen, Proof, ExistQVars,
- Context, MaybeVar, !ExtraGoals, !Info)
+ Context, TypeClassInfoVar, !ExtraGoals, !Info)
;
make_typeclass_info_head_var(do_record_type_info_locns, Constraint,
- NewVar, !Info),
+ TypeClassInfoVar, !Info),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
- rtti_reuse_typeclass_info_var(NewVar, RttiVarMaps0, RttiVarMaps),
- poly_info_set_rtti_varmaps(RttiVarMaps, !Info),
- MaybeVar = yes(NewVar)
+ rtti_reuse_typeclass_info_var(TypeClassInfoVar,
+ RttiVarMaps0, RttiVarMaps),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info)
).
:- pred make_typeclass_info_from_proof(prog_constraint::in,
list(prog_constraint)::in, constraint_proof::in, existq_tvars::in,
- prog_context::in, maybe(prog_var)::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
+ prog_context::in, prog_var::out, cord(hlds_goal)::in, cord(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
make_typeclass_info_from_proof(Constraint, Seen, Proof,
- ExistQVars, Context, MaybeVar, !ExtraGoals, !Info) :-
- Constraint = constraint(ClassName, ConstrainedTypes),
- list.length(ConstrainedTypes, ClassArity),
- ClassId = class_id(ClassName, ClassArity),
+ ExistQVars, Context, TypeClassInfoVar, !ExtraGoals, !Info) :-
(
% We have to construct the typeclass_info using an instance
% declaration.
Proof = apply_instance(InstanceNum),
- make_typeclass_info_from_instance(Constraint, Seen, ClassId,
- InstanceNum, ExistQVars, Context, MaybeVar, !ExtraGoals, !Info)
+ make_typeclass_info_from_instance(Constraint, Seen, InstanceNum,
+ ExistQVars, Context, TypeClassInfoVar, !ExtraGoals, !Info)
;
% XXX MR_Dictionary should have MR_Dictionaries for superclass
% We have to extract the typeclass_info from another one.
Proof = superclass(SubClassConstraint),
- make_typeclass_info_from_subclass(Constraint, Seen, ClassId,
- SubClassConstraint, ExistQVars, Context, MaybeVar,
- !ExtraGoals, !Info)
+ make_typeclass_info_from_subclass(Constraint, Seen, SubClassConstraint,
+ ExistQVars, Context, TypeClassInfoVar, !ExtraGoals, !Info)
).
:- pred make_typeclass_info_from_instance(prog_constraint::in,
- list(prog_constraint)::in, class_id::in, int::in, existq_tvars::in,
- prog_context::in, maybe(prog_var)::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
+ list(prog_constraint)::in, int::in, existq_tvars::in, prog_context::in,
+ prog_var::out, cord(hlds_goal)::in, cord(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
-make_typeclass_info_from_instance(Constraint, Seen, ClassId, InstanceNum,
- ExistQVars, Context, MaybeVar, !ExtraGoals, !Info) :-
- Constraint = constraint(_ClassName, ConstrainedTypes),
+make_typeclass_info_from_instance(Constraint, Seen, InstanceNum, ExistQVars,
+ Context, TypeClassInfoVar, !ExtraGoals, !Info) :-
+ Constraint = constraint(ClassName, ConstrainedTypes),
TypeVarSet = !.Info ^ poly_typevarset,
Proofs0 = !.Info ^ poly_proof_map,
ModuleInfo = !.Info ^ poly_module_info,
+ list.length(ConstrainedTypes, ClassArity),
+ ClassId = class_id(ClassName, ClassArity),
+
module_info_get_instance_table(ModuleInfo, InstanceTable),
map.lookup(InstanceTable, ClassId, InstanceList),
list.index1_det(InstanceList, InstanceNum, ProofInstanceDefn),
@@ -2466,7 +2454,7 @@
% Make the typeclass_infos for the constraints from the context of the
% instance decl.
make_typeclass_info_vars_2(ActualInstanceConstraints, Seen, ExistQVars,
- Context, [], InstanceExtraTypeClassInfoVars0, !ExtraGoals, !Info),
+ Context, InstanceExtraTypeClassInfoVars, !ExtraGoals, !Info),
% Make the type_infos for the unconstrained type variables from the head
% of the instance declaration.
@@ -2474,40 +2462,26 @@
InstanceExtraTypeInfoUnconstrainedVars, UnconstrainedTypeInfoGoals,
!Info),
- % The variables are built up in reverse order.
- list.reverse(InstanceExtraTypeClassInfoVars0,
- InstanceExtraTypeClassInfoVars),
-
- construct_typeclass_info(InstanceExtraTypeInfoUnconstrainedVars,
+ make_typeclass_info(InstanceExtraTypeInfoUnconstrainedVars,
InstanceExtraTypeInfoVars, InstanceExtraTypeClassInfoVars,
ClassId, Constraint, InstanceNum, ConstrainedTypes,
- Proofs, ExistQVars, Var, NewGoals, !Info),
-
- MaybeVar = yes(Var),
+ Proofs, ExistQVars, TypeClassInfoVar, MakeTypeClassInfoGoals, !Info),
- % Oh, yuck. The type_info goals have already been reversed, so lets
- % reverse them back.
- list.reverse(TypeInfoGoals, RevTypeInfoGoals),
- list.reverse(UnconstrainedTypeInfoGoals,
- RevUnconstrainedTypeInfoGoals),
-
- list.condense([RevUnconstrainedTypeInfoGoals, NewGoals,
- !.ExtraGoals, RevTypeInfoGoals], !:ExtraGoals).
+ !:ExtraGoals = cord.from_list(TypeInfoGoals) ++ !.ExtraGoals ++
+ MakeTypeClassInfoGoals ++ cord.from_list(UnconstrainedTypeInfoGoals).
:- pred make_typeclass_info_from_subclass(prog_constraint::in,
- list(prog_constraint)::in, class_id::in, prog_constraint::in,
- existq_tvars::in, prog_context::in, maybe(prog_var)::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
+ list(prog_constraint)::in, prog_constraint::in,
+ existq_tvars::in, prog_context::in, prog_var::out,
+ cord(hlds_goal)::in, cord(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
-make_typeclass_info_from_subclass(Constraint, Seen, ClassId,
- SubClassConstraint, ExistQVars, Context, MaybeVar,
- !ExtraGoals, !Info) :-
- ClassId = class_id(ClassName, _ClassArity),
+make_typeclass_info_from_subclass(Constraint, Seen, SubClassConstraint,
+ ExistQVars, Context, TypeClassInfoVar, !ExtraGoals, !Info) :-
% First create a variable to hold the new typeclass_info.
- ClassNameString = unqualify_name(ClassName),
- new_typeclass_info_var(Constraint, ClassNameString, Var, !Info),
- MaybeVar = yes(Var),
+ new_typeclass_info_var(Constraint, typeclass_info_kind, TypeClassInfoVar,
+ !Info),
+
% Then work out where to extract it from.
SubClassConstraint = constraint(SubClassName, SubClassTypes),
list.length(SubClassTypes, SubClassArity),
@@ -2515,14 +2489,7 @@
% Make the typeclass_info for the subclass.
make_typeclass_info_var(SubClassConstraint, Seen, ExistQVars, Context,
- !ExtraGoals, !Info, MaybeSubClassVar),
- (
- MaybeSubClassVar = yes(SubClassVar0),
- SubClassVar = SubClassVar0
- ;
- MaybeSubClassVar = no,
- unexpected(this_file, "MaybeSubClassVar = no")
- ),
+ SubClassVar, !ExtraGoals, !Info),
% Look up the definition of the subclass.
poly_info_get_module_info(!.Info, ModuleInfo),
@@ -2550,38 +2517,25 @@
% We extract the superclass typeclass_info by inserting a call
% to superclass_from_typeclass_info in private_builtin.
goal_util.generate_simple_call(mercury_private_builtin_module,
- "superclass_from_typeclass_info", pf_predicate, only_mode,
- detism_det, purity_pure, [SubClassVar, IndexVar, Var], [],
+ "superclass_from_typeclass_info", pf_predicate, only_mode, detism_det,
+ purity_pure, [SubClassVar, IndexVar, TypeClassInfoVar], [],
instmap_delta_bind_no_var, ModuleInfo, term.context_init,
SuperClassGoal),
- !:ExtraGoals = [SuperClassGoal, IndexGoal | !.ExtraGoals].
-
-:- pred construct_typeclass_info(list(prog_var)::in, list(prog_var)::in,
- list(prog_var)::in, class_id::in, prog_constraint::in, int::in,
- list(mer_type)::in, constraint_proof_map::in, existq_tvars::in,
- prog_var::out, list(hlds_goal)::out, poly_info::in, poly_info::out) is det.
+ !:ExtraGoals = !.ExtraGoals ++ cord.from_list([IndexGoal, SuperClassGoal]).
-construct_typeclass_info(ArgUnconstrainedTypeInfoVars, ArgTypeInfoVars,
- ArgTypeClassInfoVars, ClassId, Constraint, InstanceNum, InstanceTypes,
- SuperClassProofs, ExistQVars, NewVar, NewGoals, !Info) :-
- poly_info_get_module_info(!.Info, ModuleInfo),
-
- module_info_get_class_table(ModuleInfo, ClassTable),
- map.lookup(ClassTable, ClassId, ClassDefn),
-
- get_arg_superclass_vars(ClassDefn, InstanceTypes, SuperClassProofs,
- ExistQVars, ArgSuperClassVars, SuperClassGoals, !Info),
-
- % Lay out the argument variables as expected in the typeclass_info.
- ArgVars = ArgUnconstrainedTypeInfoVars ++ ArgTypeClassInfoVars ++
- ArgSuperClassVars ++ ArgTypeInfoVars,
-
- ClassId = class_id(ClassName, _Arity),
+:- pred construct_base_typeclass_info(prog_constraint::in,
+ int::in, list(mer_type)::in, prog_var::out, hlds_goal::out,
+ poly_info::in, poly_info::out) is det.
- ClassNameString = unqualify_name(ClassName),
- new_typeclass_info_var(Constraint, ClassNameString, BaseVar, !Info),
+construct_base_typeclass_info(Constraint, InstanceNum, InstanceTypes,
+ BaseVar, BaseGoal, !Info) :-
+ new_typeclass_info_var(Constraint, base_typeclass_info_kind, BaseVar,
+ !Info),
+ poly_info_get_module_info(!.Info, ModuleInfo),
module_info_get_instance_table(ModuleInfo, InstanceTable),
+ Constraint = constraint(ClassName, ConstraintArgTypes),
+ ClassId = class_id(ClassName, list.length(ConstraintArgTypes)),
map.lookup(InstanceTable, ClassId, InstanceList),
list.index1_det(InstanceList, InstanceNum, InstanceDefn),
InstanceModuleName = InstanceDefn ^ instance_module,
@@ -2600,59 +2554,142 @@
BaseUnify = unify(BaseVar, BaseTypeClassInfoTerm, BaseUnifyMode,
BaseUnification, BaseUnifyContext),
- % Create a goal_info for the unification.
+ % Create the unification goal.
set.list_to_set([BaseVar], NonLocals),
InstmapDelta = instmap_delta_bind_var(BaseVar),
goal_info_init(NonLocals, InstmapDelta, detism_det, purity_pure,
BaseGoalInfo),
+ BaseGoal = hlds_goal(BaseUnify, BaseGoalInfo).
- BaseGoal = hlds_goal(BaseUnify, BaseGoalInfo),
+:- pred construct_typeclass_info(prog_constraint::in,
+ prog_var::in, list(prog_var)::in, prog_var::out, hlds_goal::out,
+ poly_info::in, poly_info::out) is det.
+construct_typeclass_info(Constraint, BaseVar, ArgVars, TypeClassInfoVar, Goal,
+ !Info) :-
% Build a unification to add the argvars to the base_typeclass_info.
- NewConsId = typeclass_info_cell_constructor,
- NewArgVars = [BaseVar | ArgVars],
- TypeClassInfoTerm = rhs_functor(NewConsId, no, NewArgVars),
+ ConsId = typeclass_info_cell_constructor,
+ AllArgVars = [BaseVar | ArgVars],
+ TypeClassInfoTerm = rhs_functor(ConsId, no, AllArgVars),
- new_typeclass_info_var(Constraint, ClassNameString, NewVar, !Info),
+ new_typeclass_info_var(Constraint, typeclass_info_kind, TypeClassInfoVar,
+ !Info),
% Create the construction unification to initialize the variable.
UniMode = (free - ground(shared, none) ->
ground(shared, none) - ground(shared, none)),
- list.length(NewArgVars, NumArgVars),
+ list.length(AllArgVars, NumArgVars),
list.duplicate(NumArgVars, UniMode, UniModes),
- Unification = construct(NewVar, NewConsId, NewArgVars, UniModes,
+ Unification = construct(TypeClassInfoVar, ConsId, AllArgVars, UniModes,
construct_dynamically, cell_is_unique, no_construct_sub_info),
UnifyMode = (free -> ground(shared, none)) -
(ground(shared, none) -> ground(shared, none)),
UnifyContext = unify_context(umc_explicit, []),
% XXX The UnifyContext is wrong.
- Unify = unify(NewVar, TypeClassInfoTerm, UnifyMode, Unification,
- UnifyContext),
+ GoalExpr = unify(TypeClassInfoVar, TypeClassInfoTerm, UnifyMode,
+ Unification, UnifyContext),
% Create a goal_info for the unification.
goal_info_init(GoalInfo0),
- set.list_to_set([NewVar | NewArgVars], TheNonLocals),
- goal_info_set_nonlocals(TheNonLocals, GoalInfo0, GoalInfo1),
+ set.list_to_set([TypeClassInfoVar | AllArgVars], NonLocals),
+ goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo1),
list.duplicate(NumArgVars, ground(shared, none), ArgInsts),
% Note that we could perhaps be more accurate than `ground(shared)',
% but it shouldn't make any difference.
InstConsId = cell_inst_cons_id(typeclass_info_cell, NumArgVars),
- InstMapDelta = instmap_delta_from_assoc_list(
- [NewVar - bound(unique, [bound_functor(InstConsId, ArgInsts)])]),
+ TypeClassInfoInst = bound(unique, [bound_functor(InstConsId, ArgInsts)]),
+ InstMapDelta =
+ instmap_delta_from_assoc_list([TypeClassInfoVar - TypeClassInfoInst]),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo1, GoalInfo2),
goal_info_set_determinism(detism_det, GoalInfo2, GoalInfo),
- TypeClassInfoGoal = hlds_goal(Unify, GoalInfo),
- NewGoals = [TypeClassInfoGoal, BaseGoal] ++ SuperClassGoals.
+ Goal = hlds_goal(GoalExpr, GoalInfo).
+
+:- pred make_typeclass_info(list(prog_var)::in, list(prog_var)::in,
+ list(prog_var)::in, class_id::in, prog_constraint::in, int::in,
+ list(mer_type)::in, constraint_proof_map::in, existq_tvars::in,
+ prog_var::out, cord(hlds_goal)::out, poly_info::in, poly_info::out) is det.
+
+make_typeclass_info(ArgUnconstrainedTypeInfoVars, ArgTypeInfoVars,
+ ArgTypeClassInfoVars, ClassId, Constraint, InstanceNum, InstanceTypes,
+ SuperClassProofs, ExistQVars, TypeClassInfoVar, Goals, !Info) :-
+ poly_info_get_module_info(!.Info, ModuleInfo),
+
+ module_info_get_class_table(ModuleInfo, ClassTable),
+ map.lookup(ClassTable, ClassId, ClassDefn),
+
+ get_arg_superclass_vars(ClassDefn, InstanceTypes, SuperClassProofs,
+ ExistQVars, ArgSuperClassVars, SuperClassGoals, !Info),
+
+ % Lay out the argument variables as expected in the typeclass_info.
+ ArgVars = ArgUnconstrainedTypeInfoVars ++ ArgTypeClassInfoVars ++
+ ArgSuperClassVars ++ ArgTypeInfoVars,
+
+ Constraint = constraint(ConstraintClassName, ConstraintArgTypes),
+ poly_info_get_typeclass_info_map(!.Info, TypeClassInfoMap0),
+ ( map.search(TypeClassInfoMap0, ConstraintClassName, ClassNameMap0) ->
+ ( map.search(ClassNameMap0, ConstraintArgTypes, OldEntry) ->
+ OldEntry = typeclass_info_map_entry(BaseVar, ArgsMap0),
+ ( map.search(ArgsMap0, ArgVars, OldTypeClassInfoVar) ->
+ TypeClassInfoVar = OldTypeClassInfoVar,
+ Goals = SuperClassGoals,
+ poly_info_get_num_reuses(!.Info, NumReuses),
+ poly_info_set_num_reuses(NumReuses + 2, !Info)
+ ;
+ construct_typeclass_info(Constraint, BaseVar, ArgVars,
+ TypeClassInfoVar, TypeClassInfoGoal, !Info),
+ Goals = SuperClassGoals ++
+ cord.singleton(TypeClassInfoGoal),
+ poly_info_get_num_reuses(!.Info, NumReuses),
+ poly_info_set_num_reuses(NumReuses + 1, !Info),
+ svmap.det_insert(ArgVars, TypeClassInfoVar, ArgsMap0, ArgsMap),
+ Entry = typeclass_info_map_entry(BaseVar, ArgsMap),
+ svmap.det_update(ConstraintArgTypes, Entry,
+ ClassNameMap0, ClassNameMap),
+ svmap.det_update(ConstraintClassName, ClassNameMap,
+ TypeClassInfoMap0, TypeClassInfoMap),
+ poly_info_set_typeclass_info_map(TypeClassInfoMap, !Info)
+ )
+ ;
+ construct_base_typeclass_info(Constraint,
+ InstanceNum, InstanceTypes, BaseVar, BaseGoal, !Info),
+ construct_typeclass_info(Constraint, BaseVar, ArgVars,
+ TypeClassInfoVar, TypeClassInfoGoal, !Info),
+ Goals = SuperClassGoals ++
+ cord.from_list([BaseGoal, TypeClassInfoGoal]),
+ svmap.det_insert(ArgVars, TypeClassInfoVar, map.init, ArgsMap),
+ Entry = typeclass_info_map_entry(BaseVar, ArgsMap),
+ svmap.det_insert(ConstraintArgTypes, Entry,
+ ClassNameMap0, ClassNameMap),
+ svmap.det_update(ConstraintClassName, ClassNameMap,
+ TypeClassInfoMap0, TypeClassInfoMap),
+ poly_info_set_typeclass_info_map(TypeClassInfoMap, !Info)
+ )
+ ;
+ construct_base_typeclass_info(Constraint,
+ InstanceNum, InstanceTypes, BaseVar, BaseGoal, !Info),
+ construct_typeclass_info(Constraint, BaseVar, ArgVars,
+ TypeClassInfoVar, TypeClassInfoGoal, !Info),
+ Goals = SuperClassGoals ++
+ cord.from_list([BaseGoal, TypeClassInfoGoal]),
+ svmap.det_insert(ArgVars, TypeClassInfoVar, map.init, ArgsMap),
+ Entry = typeclass_info_map_entry(BaseVar, ArgsMap),
+ svmap.det_insert(ConstraintArgTypes, Entry,
+ map.init, ClassNameMap),
+ svmap.det_insert(ConstraintClassName, ClassNameMap,
+ TypeClassInfoMap0, TypeClassInfoMap),
+ poly_info_set_typeclass_info_map(TypeClassInfoMap, !Info)
+ ).
%---------------------------------------------------------------------------%
:- pred get_arg_superclass_vars(hlds_class_defn::in, list(mer_type)::in,
- constraint_proof_map::in, existq_tvars::in, list(prog_var)::out,
- list(hlds_goal)::out, poly_info::in, poly_info::out) is det.
+ constraint_proof_map::in, existq_tvars::in,
+ list(prog_var)::out, cord(hlds_goal)::out,
+ poly_info::in, poly_info::out) is det.
get_arg_superclass_vars(ClassDefn, InstanceTypes, SuperClassProofs, ExistQVars,
- NewVars, NewGoals, !Info) :-
+ SuperClassTypeClassInfoVars, SuperClassGoals, !Info) :-
poly_info_get_proofs(!.Info, Proofs),
poly_info_get_typevarset(!.Info, TVarSet0),
@@ -2671,39 +2708,31 @@
SuperClasses),
poly_info_set_proofs(SuperClassProofs, !Info),
- make_superclasses_from_proofs(SuperClasses, ExistQVars, [], NewGoals,
- !Info, [], NewVars),
-
+ make_superclasses_from_proofs(SuperClasses, ExistQVars,
+ SuperClassTypeClassInfoVars, cord.empty, SuperClassGoals, !Info),
poly_info_set_proofs(Proofs, !Info).
:- pred make_superclasses_from_proofs(list(prog_constraint)::in,
- existq_tvars::in, list(hlds_goal)::in, list(hlds_goal)::out,
- poly_info::in, poly_info::out, list(prog_var)::in, list(prog_var)::out)
- is det.
+ existq_tvars::in, list(prog_var)::out,
+ cord(hlds_goal)::in, cord(hlds_goal)::out,
+ poly_info::in, poly_info::out) is det.
-make_superclasses_from_proofs([], _, !Goals, !Info, !Vars).
+make_superclasses_from_proofs([], _, [], !Goals, !Info).
make_superclasses_from_proofs([Constraint | Constraints], ExistQVars,
- !Goals, !Info, !Vars) :-
- make_superclasses_from_proofs(Constraints, ExistQVars,
- !Goals, !Info, !Vars),
+ [TypeClassInfoVar | TypeClassInfoVars], !Goals, !Info) :-
term.context_init(Context),
make_typeclass_info_var(Constraint, [], ExistQVars, Context,
- !Goals, !Info, MaybeVar),
- maybe_insert_var(MaybeVar, !Vars).
-
-:- pred maybe_insert_var(maybe(prog_var)::in, list(prog_var)::in,
- list(prog_var)::out) is det.
-
-maybe_insert_var(no, Vars, Vars).
-maybe_insert_var(yes(Var), Vars, [Var | Vars]).
+ TypeClassInfoVar, !Goals, !Info),
+ make_superclasses_from_proofs(Constraints, ExistQVars,
+ TypeClassInfoVars, !Goals, !Info).
%-----------------------------------------------------------------------------%
% Produce the typeclass_infos for the existential class constraints
% for a call or deconstruction unification.
%
-:- pred make_existq_typeclass_info_vars(
- list(prog_constraint)::in, list(prog_var)::out, list(hlds_goal)::out,
+:- pred make_existq_typeclass_info_vars(list(prog_constraint)::in,
+ list(prog_var)::out, list(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
make_existq_typeclass_info_vars(ExistentialConstraints, ExtraTypeClassVars,
@@ -2839,28 +2868,33 @@
list(hlds_goal)::out, poly_info::in, poly_info::out) is det.
polymorphism_make_type_info(Type, TypeCtor, TypeArgs, TypeCtorIsVarArity,
- Context, Var, ExtraGoals, !Info) :-
+ Context, TypeInfoVar, ExtraGoals, !Info) :-
poly_info_get_type_info_var_map(!.Info, TypeInfoVarMap0),
- ( map.search(TypeInfoVarMap0, TypeCtor, TypeCtorVarMap0) ->
- ( map.search(TypeCtorVarMap0, TypeArgs, OldVar) ->
+ (
+ map.search(TypeInfoVarMap0, TypeCtor, TypeCtorVarMap0),
+ map.search(TypeCtorVarMap0, TypeArgs, OldTypeInfoVar)
+ ->
poly_info_get_num_reuses(!.Info, NumReuses),
poly_info_set_num_reuses(NumReuses + 1, !Info),
- Var = OldVar,
+ TypeInfoVar = OldTypeInfoVar,
ExtraGoals = []
;
polymorphism_construct_type_info(Type, TypeCtor, TypeArgs,
- TypeCtorIsVarArity, Context, Var, ExtraGoals, !Info),
- map.det_insert(TypeCtorVarMap0, TypeArgs, Var, TypeCtorVarMap),
- map.det_update(TypeInfoVarMap0, TypeCtor, TypeCtorVarMap,
- TypeInfoVarMap),
- poly_info_set_type_info_var_map(TypeInfoVarMap, !Info)
- )
- ;
- polymorphism_construct_type_info(Type, TypeCtor, TypeArgs,
- TypeCtorIsVarArity, Context, Var, ExtraGoals, !Info),
- map.det_insert(map.init, TypeArgs, Var, TypeCtorVarMap),
- map.det_insert(TypeInfoVarMap0, TypeCtor, TypeCtorVarMap,
- TypeInfoVarMap),
+ TypeCtorIsVarArity, Context, TypeInfoVar, ExtraGoals, !Info),
+ % We have to get the type_info_var_map again since the call just above
+ % could have added relevant new entries to it.
+ poly_info_get_type_info_var_map(!.Info, TypeInfoVarMap1),
+ ( map.search(TypeInfoVarMap1, TypeCtor, TypeCtorVarMap1) ->
+ svmap.det_insert(TypeArgs, TypeInfoVar,
+ TypeCtorVarMap1, TypeCtorVarMap),
+ svmap.det_update(TypeCtor, TypeCtorVarMap,
+ TypeInfoVarMap1, TypeInfoVarMap)
+ ;
+ svmap.det_insert(TypeArgs, TypeInfoVar,
+ map.init, TypeCtorVarMap),
+ svmap.det_insert(TypeCtor, TypeCtorVarMap,
+ TypeInfoVarMap1, TypeInfoVarMap)
+ ),
poly_info_set_type_info_var_map(TypeInfoVarMap, !Info)
).
@@ -2879,12 +2913,28 @@
poly_info_get_module_info(!.Info, ModuleInfo),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
- init_const_type_ctor_info_var(Type, TypeCtor, TypeCtorVar, TypeCtorGoal,
- ModuleInfo, VarSet0, VarSet1, VarTypes0, VarTypes1,
+ poly_info_get_type_ctor_info_var_map(!.Info, TypeCtorInfoVarMap0),
+ ( map.search(TypeCtorInfoVarMap0, TypeCtor, OldTypeCtorVar) ->
+ poly_info_get_num_reuses(!.Info, NumReuses),
+ poly_info_set_num_reuses(NumReuses + 1, !Info),
+ TypeCtorVar = OldTypeCtorVar,
+ TypeCtorGoals = [],
+ VarSet1 = VarSet0,
+ VarTypes1 = VarTypes0,
+ RttiVarMaps1 = RttiVarMaps0
+ ;
+ init_const_type_ctor_info_var(Type, TypeCtor, TypeCtorVar,
+ TypeCtorGoal, ModuleInfo, VarSet0, VarSet1, VarTypes0, VarTypes1,
RttiVarMaps0, RttiVarMaps1),
+ TypeCtorGoals = [TypeCtorGoal],
+ svmap.det_insert(TypeCtor, TypeCtorVar,
+ TypeCtorInfoVarMap0, TypeCtorInfoVarMap),
+ poly_info_set_type_ctor_info_var_map(TypeCtorInfoVarMap, !Info)
+ ),
+
maybe_init_second_cell(Type, TypeCtorVar, TypeCtorIsVarArity,
ArgTypeInfoVars, Context, Var, VarSet1, VarSet, VarTypes1, VarTypes,
- RttiVarMaps1, RttiVarMaps, ArgTypeInfoGoals, [TypeCtorGoal],
+ RttiVarMaps1, RttiVarMaps, ArgTypeInfoGoals, TypeCtorGoals,
ExtraGoals),
poly_info_set_varset_and_types(VarSet, VarTypes, !Info),
@@ -2975,12 +3025,8 @@
(
MaybeCategoryName = no,
module_info_get_special_pred_map(ModuleInfo, SpecialPredMap),
- ( type_to_ctor_and_args(Type, TypeCtor, _TypeArgs) ->
- map.search(SpecialPredMap, SpecialPredId - TypeCtor, PredId)
- ;
- unexpected(this_file,
- "get_special_proc: type_to_ctor_and_args failed")
- ),
+ type_to_ctor_det(Type, TypeCtor),
+ map.search(SpecialPredMap, SpecialPredId - TypeCtor, PredId),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
Module = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
@@ -3046,12 +3092,8 @@
init_type_info_var(Type, ArgVars, MaybePreferredVar, TypeInfoVar, TypeInfoGoal,
!VarSet, !VarTypes, !RttiVarMaps) :-
- ( type_to_ctor(Type, TypeCtor) ->
- Cell = type_info_cell(TypeCtor)
- ;
- unexpected(this_file,
- "init_type_info_var: type_to_ctor_and_args failed")
- ),
+ type_to_ctor_det(Type, TypeCtor),
+ Cell = type_info_cell(TypeCtor),
ConsId = cell_cons_id(Cell),
TypeInfoTerm = rhs_functor(ConsId, no, ArgVars),
% Introduce a new variable.
@@ -3059,8 +3101,8 @@
MaybePreferredVar = yes(TypeInfoVar)
;
MaybePreferredVar = no,
- new_type_info_var_raw(Type, type_info,
- TypeInfoVar, !VarSet, !VarTypes, !RttiVarMaps)
+ new_type_info_var_raw(Type, type_info, TypeInfoVar,
+ !VarSet, !VarTypes, !RttiVarMaps)
),
% Create the construction unification to initialize the variable.
@@ -3156,11 +3198,11 @@
string.int_to_string(VarNum, VarNumStr),
(
Kind = type_info,
- Prefix = typeinfo_prefix,
+ Prefix = "TypeInfo_",
rtti_det_insert_type_info_type(Var, Type, !RttiVarMaps)
;
Kind = type_ctor_info,
- Prefix = typectorinfo_prefix
+ Prefix = "TypeCtorInfo_"
% XXX Perhaps we should record the variables holding
% type_ctor_infos in the rtti_varmaps somewhere.
@@ -3169,14 +3211,6 @@
svvarset.name_var(Var, Name, !VarSet),
svmap.det_insert(Var, type_info_type, !VarTypes).
-:- func typeinfo_prefix = string.
-
-typeinfo_prefix = "TypeInfo_".
-
-:- func typectorinfo_prefix = string.
-
-typectorinfo_prefix = "TypeCtorInfo_".
-
%---------------------------------------------------------------------------%
% Generate code to get the value of a type variable.
@@ -3259,21 +3293,23 @@
:- pred make_typeclass_info_head_var(record_type_info_locns::in,
prog_constraint::in, prog_var::out, poly_info::in, poly_info::out) is det.
-make_typeclass_info_head_var(RecordLocns, Constraint, ExtraHeadVar, !Info) :-
+make_typeclass_info_head_var(RecordLocns, Constraint, TypeClassInfoVar,
+ !Info) :-
(
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
- rtti_search_typeclass_info_var(RttiVarMaps0, Constraint, ExistingVar)
+ rtti_search_typeclass_info_var(RttiVarMaps0, Constraint,
+ OldTypeClassInfoVar)
->
- ExtraHeadVar = ExistingVar
+ TypeClassInfoVar = OldTypeClassInfoVar
;
% Make a new variable to contain the dictionary for this typeclass
% constraint.
- Constraint = constraint(ClassSymName, _ClassTypes),
- ClassName = unqualify_name(ClassSymName),
- new_typeclass_info_var(Constraint, ClassName, ExtraHeadVar, !Info),
+ new_typeclass_info_var(Constraint, typeclass_info_kind,
+ TypeClassInfoVar, !Info),
(
RecordLocns = do_record_type_info_locns,
- record_constraint_type_info_locns(Constraint, ExtraHeadVar, !Info)
+ record_constraint_type_info_locns(Constraint, TypeClassInfoVar,
+ !Info)
;
RecordLocns = do_not_record_type_info_locns
)
@@ -3334,17 +3370,30 @@
list.foldl(MakeEntry, NewClassTypeVars, RttiVarMaps0, RttiVarMaps),
poly_info_set_rtti_varmaps(RttiVarMaps, !Info).
-:- pred new_typeclass_info_var(prog_constraint::in, string::in,
+:- type tci_var_kind
+ ---> base_typeclass_info_kind
+ ; typeclass_info_kind.
+
+:- pred new_typeclass_info_var(prog_constraint::in, tci_var_kind::in,
prog_var::out, poly_info::in, poly_info::out) is det.
-new_typeclass_info_var(Constraint, ClassString, Var, !Info) :-
+new_typeclass_info_var(Constraint, VarKind, Var, !Info) :-
poly_info_get_varset(!.Info, VarSet0),
poly_info_get_var_types(!.Info, VarTypes0),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ Constraint = constraint(ClassName, _),
+ ClassNameString = unqualify_name(ClassName),
+
% Introduce new variable.
varset.new_var(VarSet0, Var, VarSet1),
- Name = "TypeClassInfo_for_" ++ ClassString,
+ (
+ VarKind = base_typeclass_info_kind,
+ Name = "BaseTypeClassInfo_for_" ++ ClassNameString
+ ;
+ VarKind = typeclass_info_kind,
+ Name = "TypeClassInfo_for_" ++ ClassNameString
+ ),
varset.name_var(VarSet1, Var, Name, VarSet),
build_typeclass_info_type(Constraint, DictionaryType),
map.set(VarTypes0, Var, DictionaryType, VarTypes),
@@ -3362,7 +3411,7 @@
%---------------------------------------------------------------------------%
type_is_typeclass_info(TypeClassInfoType) :-
- type_to_ctor_and_args(TypeClassInfoType, TypeCtor, [_ConstraintTerm]),
+ type_to_ctor(TypeClassInfoType, TypeCtor),
TypeCtor = type_ctor(qualified(ModuleName, "typeclass_info"), 0),
ModuleName = mercury_private_builtin_module.
@@ -3577,7 +3626,26 @@
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
-:- type type_info_var_map == map(type_ctor, map(list(mer_type), prog_var)).
+:- type type_ctor_info_var_map ==
+ map(type_ctor, prog_var).
+
+:- type type_info_var_map ==
+ map(type_ctor, map(list(mer_type), prog_var)).
+
+:- type typeclass_info_map_entry
+ ---> typeclass_info_map_entry(
+ % The variable that holds the base_typeclass_info for the
+ % constraint.
+ prog_var,
+
+ % Maps the arguments of the typeclass_info_cell_constructor
+ % after the base_typeclass_info to the variable that holds the
+ % typeclass_info for that cell.
+ map(list(prog_var), prog_var)
+ ).
+
+:- type typeclass_info_map ==
+ map(class_name, map(list(mer_type), typeclass_info_map_entry)).
:- type poly_info
---> poly_info(
@@ -3605,7 +3673,16 @@
% Specifies the constraints at each location in the goal.
poly_constraint_map :: constraint_map,
+ % The next three maps hold information about what
+ % type_ctor_infos, type_infos, base_typeclass_infos and
+ % typeclass_infos are guaranteed to be available (i.e. created
+ % by previous code on all execution paths) at the current point
+ % in the code, so they can be reused. The fourth field counts
+ % the number of times that one of these variables has in fact
+ % been reused.
+ poly_type_ctor_info_var_map :: type_ctor_info_var_map,
poly_type_info_var_map :: type_info_var_map,
+ poly_typeclass_info_map :: typeclass_info_map,
poly_num_reuses :: int,
poly_pred_info :: pred_info,
@@ -3628,11 +3705,13 @@
pred_info_get_constraint_proofs(PredInfo, Proofs),
pred_info_get_constraint_map(PredInfo, ConstraintMap),
rtti_varmaps_init(RttiVarMaps),
+ map.init(TypeCtorInfoVarMap),
map.init(TypeInfoVarMap),
+ map.init(TypeClassInfoMap),
NumReuses = 0,
PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarKinds,
- RttiVarMaps, Proofs, ConstraintMap, TypeInfoVarMap, NumReuses,
- PredInfo, ModuleInfo).
+ RttiVarMaps, Proofs, ConstraintMap, TypeCtorInfoVarMap, TypeInfoVarMap,
+ TypeClassInfoMap, NumReuses, PredInfo, ModuleInfo).
% Create_poly_info creates a poly_info for an existing procedure.
% (See also init_poly_info.)
@@ -3645,15 +3724,18 @@
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_vartypes(ProcInfo, VarTypes),
proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
+ map.init(TypeCtorInfoVarMap),
map.init(TypeInfoVarMap),
+ map.init(TypeClassInfoMap),
NumReuses = 0,
PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarKinds,
- RttiVarMaps, Proofs, ConstraintMap, TypeInfoVarMap, NumReuses,
- PredInfo, ModuleInfo).
+ RttiVarMaps, Proofs, ConstraintMap, TypeCtorInfoVarMap, TypeInfoVarMap,
+ TypeClassInfoMap, NumReuses, PredInfo, ModuleInfo).
poly_info_extract(Info, !PredInfo, !ProcInfo, ModuleInfo) :-
Info = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarKinds,
- RttiVarMaps, _Proofs, _ConstraintMap, _TypeInfoVarMap, _NumReuses,
+ RttiVarMaps, _Proofs, _ConstraintMap,
+ _TypeCtorInfoVarMap, _TypeInfoVarMap, _TypeClassInfoMap, _NumReuses,
_OldPredInfo, ModuleInfo),
% Set the new values of the fields in proc_info and pred_info.
@@ -3673,8 +3755,12 @@
:- pred poly_info_get_proofs(poly_info::in, constraint_proof_map::out) is det.
:- pred poly_info_get_constraint_map(poly_info::in, constraint_map::out)
is det.
-:- pred poly_info_get_type_info_var_map(poly_info::in, type_info_var_map::out)
- is det.
+:- pred poly_info_get_type_ctor_info_var_map(poly_info::in,
+ type_ctor_info_var_map::out) is det.
+:- pred poly_info_get_type_info_var_map(poly_info::in,
+ type_info_var_map::out) is det.
+:- pred poly_info_get_typeclass_info_map(poly_info::in,
+ typeclass_info_map::out) is det.
:- pred poly_info_get_num_reuses(poly_info::in, int::out) is det.
:- pred poly_info_get_pred_info(poly_info::in, pred_info::out) is det.
:- pred poly_info_get_module_info(poly_info::in, module_info::out) is det.
@@ -3686,7 +3772,10 @@
poly_info_get_rtti_varmaps(PolyInfo, PolyInfo ^ poly_rtti_varmaps).
poly_info_get_proofs(PolyInfo, PolyInfo ^ poly_proof_map).
poly_info_get_constraint_map(PolyInfo, PolyInfo ^ poly_constraint_map).
+poly_info_get_type_ctor_info_var_map(PolyInfo,
+ PolyInfo ^ poly_type_ctor_info_var_map).
poly_info_get_type_info_var_map(PolyInfo, PolyInfo ^ poly_type_info_var_map).
+poly_info_get_typeclass_info_map(PolyInfo, PolyInfo ^ poly_typeclass_info_map).
poly_info_get_num_reuses(PolyInfo, PolyInfo ^ poly_num_reuses).
poly_info_get_pred_info(PolyInfo, PolyInfo ^ poly_pred_info).
poly_info_get_module_info(PolyInfo, PolyInfo ^ poly_module_info).
@@ -3703,8 +3792,12 @@
poly_info::in, poly_info::out) is det.
:- pred poly_info_set_proofs(constraint_proof_map::in,
poly_info::in, poly_info::out) is det.
+:- pred poly_info_set_type_ctor_info_var_map(type_ctor_info_var_map::in,
+ poly_info::in, poly_info::out) is det.
:- pred poly_info_set_type_info_var_map(type_info_var_map::in,
poly_info::in, poly_info::out) is det.
+:- pred poly_info_set_typeclass_info_map(typeclass_info_map::in,
+ poly_info::in, poly_info::out) is det.
:- pred poly_info_set_num_reuses(int::in,
poly_info::in, poly_info::out) is det.
@@ -3721,11 +3814,41 @@
!PI ^ poly_rtti_varmaps := RttiVarMaps.
poly_info_set_proofs(Proofs, !PI) :-
!PI ^ poly_proof_map := Proofs.
+poly_info_set_type_ctor_info_var_map(TypeCtorInfoVarMap, !PI) :-
+ !PI ^ poly_type_ctor_info_var_map := TypeCtorInfoVarMap.
poly_info_set_type_info_var_map(TypeInfoVarMap, !PI) :-
!PI ^ poly_type_info_var_map := TypeInfoVarMap.
+poly_info_set_typeclass_info_map(TypeClassInfoMap, !PI) :-
+ !PI ^ poly_typeclass_info_map := TypeClassInfoMap.
poly_info_set_num_reuses(NumReuses, !PI) :-
!PI ^ poly_num_reuses := NumReuses.
+:- type maps_snapshot
+ ---> maps_snapshot(poly_info).
+ % We could remember only the fields of the poly_info that we
+ % actually need in the snapshot, but that would require more memory
+ % allocation.
+
+:- pred get_maps_snapshot(poly_info::in, maps_snapshot::out) is det.
+:- pred set_maps_snapshot(maps_snapshot::in, poly_info::in, poly_info::out)
+ is det.
+:- pred empty_maps(poly_info::in, poly_info::out) is det.
+
+get_maps_snapshot(Info, maps_snapshot(Info)).
+
+set_maps_snapshot(maps_snapshot(SnapshotInfo), !Info) :-
+ TypeCtorInfoVarMap = SnapshotInfo ^ poly_type_ctor_info_var_map,
+ TypeInfoVarMap = SnapshotInfo ^ poly_type_info_var_map,
+ TypeClassInfoMap = SnapshotInfo ^ poly_typeclass_info_map,
+ !Info ^ poly_type_ctor_info_var_map := TypeCtorInfoVarMap,
+ !Info ^ poly_type_info_var_map := TypeInfoVarMap,
+ !Info ^ poly_typeclass_info_map := TypeClassInfoMap.
+
+empty_maps(!Info) :-
+ !Info ^ poly_type_ctor_info_var_map := map.init,
+ !Info ^ poly_type_info_var_map := map.init,
+ !Info ^ poly_typeclass_info_map := map.init.
+
%---------------------------------------------------------------------------%
:- func this_file = string.
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/list.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.184
diff -u -b -r1.184 list.m
--- library/list.m 2 Sep 2009 05:48:01 -0000 1.184
+++ library/list.m 14 Sep 2009 17:09:41 -0000
@@ -1259,6 +1259,13 @@
:- pred list.all_false(pred(X)::in(pred(in) is semidet), list(X)::in)
is semidet.
+ % list.find_first_match(Pred, List, FirstMatch) takes a closure with one
+ % input argument. It returns the element X of the list (if any) for which
+ % Pred(X) is true.
+ %
+:- pred list.find_first_match(pred(X)::in(pred(in) is semidet), list(X)::in,
+ X::out) is semidet.
+
% list.filter(Pred, List, TrueList) takes a closure with one
% input argument and for each member of List `X', calls the closure.
% Iff Pred(X) is true, then X is included in TrueList.
@@ -1776,20 +1783,40 @@
list.merge_sort(L0, L).
list.sort_and_remove_dups(L0, L) :-
- list.merge_sort(L0, L1),
- list.remove_adjacent_dups(L1, L).
-
-%-----------------------------------------------------------------------------%
+ list.merge_sort_and_remove_dups_2(list.length(L0), L0, L).
:- pred list.merge_sort(list(T)::in, list(T)::out) is det.
-
:- pragma type_spec(list.merge_sort(in, out), T = var(_)).
list.merge_sort(List, SortedList) :-
list.merge_sort_2(list.length(List), List, SortedList).
-:- pred list.merge_sort_2(int::in, list(T)::in, list(T)::out) is det.
+%-----------------------------------------------------------------------------%
+
+:- pred list.merge_sort_and_remove_dups_2(int::in, list(T)::in, list(T)::out)
+ is det.
+:- pragma type_spec(list.merge_sort_and_remove_dups_2(in, in, out),
+ T = var(_)).
+list.merge_sort_and_remove_dups_2(Length, List, SortedList) :-
+ ( Length > 1 ->
+ HalfLength = Length // 2,
+ ( list.split_list(HalfLength, List, Front, Back) ->
+ list.merge_sort_and_remove_dups_2(HalfLength,
+ Front, SortedFront),
+ list.merge_sort_and_remove_dups_2(Length - HalfLength,
+ Back, SortedBack),
+ list.merge_and_remove_dups(SortedFront, SortedBack, SortedList)
+ ;
+ error("list.merge_sort_and_remove_dups_2")
+ )
+ ;
+ SortedList = List
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred list.merge_sort_2(int::in, list(T)::in, list(T)::out) is det.
:- pragma type_spec(list.merge_sort_2(in, in, out), T = var(_)).
list.merge_sort_2(Length, List, SortedList) :-
@@ -1797,8 +1824,7 @@
HalfLength = Length // 2,
( list.split_list(HalfLength, List, Front, Back) ->
list.merge_sort_2(HalfLength, Front, SortedFront),
- list.merge_sort_2(Length - HalfLength,
- Back, SortedBack),
+ list.merge_sort_2(Length - HalfLength, Back, SortedBack),
list.merge(SortedFront, SortedBack, SortedList)
;
error("list.merge_sort_2")
@@ -1870,12 +1896,10 @@
).
list.det_split_list(N, List, Start, End) :-
- ( if
- list.split_list(N, List, Start0, End0)
- then
+ ( list.split_list(N, List, Start0, End0) ->
Start = Start0,
End = End0
- else
+ ;
error("list.det_split_list: index out of range")
).
@@ -2389,6 +2413,13 @@
not P(X),
list.all_false(P, Xs).
+list.find_first_match(P, [H | T], FirstMatch) :-
+ ( P(H) ->
+ FirstMatch = H
+ ;
+ list.find_first_match(P, T, FirstMatch)
+ ).
+
list.filter(_, [], []).
list.filter(P, [H | T], True) :-
list.filter(P, T, TrueTail),
@@ -2511,18 +2542,19 @@
error("hosort failed")
).
- % list.hosort is actually det but the compiler can't confirm it.
+ % list.hosort is a Mercury implementation of the mergesort described
+ % in The Craft of Prolog.
+ %
+ % N denotes the length of the part of L0 that this call is sorting.
+ % (require((length(L0, M), M >= N)))
+ % Since we have redundant information about the list (N, and the length
+ % implicit in the list itself), we get a semidet unification when we
+ % deconstruct the list. list.hosort is therefore actually det but the
+ % compiler can't confirm it.
%
:- pred list.hosort(comparison_pred(X)::in(comparison_pred), int::in,
list(X)::in, list(X)::out, list(X)::out) is semidet.
- % list.hosort is a Mercury implementation of the mergesort
- % described in The Craft of Prolog.
- % N denotes the length of the part of L0 that this call is sorting.
- % (require((length(L0, M), M >= N)))
- % Since we have redundant information about the list (N, and the
- % length implicit in the list itself), we get a semidet unification
- % when we deconstruct the list.
list.hosort(P, N, L0, L, Rest) :-
( N = 1 ->
L0 = [X | Rest],
@@ -2553,11 +2585,11 @@
list.merge(_P, [X | Xs], [], [X | Xs]).
list.merge(P, [H1 | T1], [H2 | T2], L) :-
( P(H1, H2, (>)) ->
- L = [H2 | T],
- list.merge(P, [H1 | T1], T2, T)
+ list.merge(P, [H1 | T1], T2, T),
+ L = [H2 | T]
;
- L = [H1 | T],
- list.merge(P, T1, [H2 | T2], T)
+ list.merge(P, T1, [H2 | T2], T),
+ L = [H1 | T]
).
list.merge_and_remove_dups(_P, [], [], []).
@@ -2567,16 +2599,16 @@
P(H1, H2, C),
(
C = (<),
- L = [H1 | T],
- list.merge_and_remove_dups(P, T1, [H2 | T2], T)
+ list.merge_and_remove_dups(P, T1, [H2 | T2], T),
+ L = [H1 | T]
;
C = (=),
- L = [H1 | T],
- list.merge_and_remove_dups(P, T1, T2, T)
+ list.merge_and_remove_dups(P, T1, T2, T),
+ L = [H1 | T]
;
C = (>),
- L = [H2 | T],
- list.merge_and_remove_dups(P, [H1 | T1], T2, T)
+ list.merge_and_remove_dups(P, [H1 | T1], T2, T),
+ L = [H2 | T]
).
%-----------------------------------------------------------------------------%
Index: library/map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.118
diff -u -b -r1.118 map.m
--- library/map.m 4 Sep 2009 02:53:36 -0000 1.118
+++ library/map.m 15 Sep 2009 03:07:17 -0000
@@ -312,19 +312,6 @@
:- mode map.foldl(pred(in, in, mdi, muo) is cc_multi, in, mdi, muo)
is cc_multi.
-:- func map.foldr(func(K, V, A) = A, map(K, V), A) = A.
-:- pred map.foldr(pred(K, V, A, A), map(K, V), A, A).
-:- mode map.foldr(pred(in, in, in, out) is det, in, in, out) is det.
-:- mode map.foldr(pred(in, in, mdi, muo) is det, in, mdi, muo) is det.
-:- mode map.foldr(pred(in, in, di, uo) is det, in, di, uo) is det.
-:- mode map.foldr(pred(in, in, in, out) is semidet, in, in, out) is semidet.
-:- mode map.foldr(pred(in, in, mdi, muo) is semidet, in, mdi, muo) is semidet.
-:- mode map.foldr(pred(in, in, di, uo) is semidet, in, di, uo) is semidet.
-:- mode map.foldr(pred(in, in, in, out) is cc_multi, in, in, out) is cc_multi.
-:- mode map.foldr(pred(in, in, di, uo) is cc_multi, in, di, uo) is cc_multi.
-:- mode map.foldr(pred(in, in, mdi, muo) is cc_multi, in, mdi, muo)
- is cc_multi.
-
% Perform an inorder traversal of the map, applying an accumulator
% predicate with two accumulators for each key-value pair.
% (Although no more expressive than map.foldl, this is often
@@ -346,16 +333,6 @@
:- mode map.foldl2(pred(in, in, in, out, di, uo) is semidet,
in, in, out, di, uo) is semidet.
-:- pred map.foldr2(pred(K, V, A, A, B, B), map(K, V), A, A, B, B).
-:- mode map.foldr2(pred(in, in, in, out, in, out) is det,
- in, in, out, in, out) is det.
-:- mode map.foldr2(pred(in, in, in, out, in, out) is semidet,
- in, in, out, in, out) is semidet.
-:- mode map.foldr2(pred(in, in, in, out, di, uo) is det,
- in, in, out, di, uo) is det.
-:- mode map.foldr2(pred(in, in, di, uo, di, uo) is det,
- in, di, uo, di, uo) is det.
-
% Perform an inorder traversal of the map, applying an accumulator
% predicate with three accumulators for each key-value pair.
% (Although no more expressive than map.foldl, this is often
@@ -373,18 +350,6 @@
:- mode map.foldl3(pred(in, in, di, uo, di, uo, di, uo) is det,
in, di, uo, di, uo, di, uo) is det.
-:- pred map.foldr3(pred(K, V, A, A, B, B, C, C), map(K, V), A, A, B, B, C, C).
-:- mode map.foldr3(pred(in, in, in, out, in, out, in, out) is det,
- in, in, out, in, out, in, out) is det.
-:- mode map.foldr3(pred(in, in, in, out, in, out, in, out) is semidet,
- in, in, out, in, out, in, out) is semidet.
-:- mode map.foldr3(pred(in, in, in, out, in, out, di, uo) is det,
- in, in, out, in, out, di, uo) is det.
-:- mode map.foldr3(pred(in, in, in, out, di, uo, di, uo) is det,
- in, in, out, di, uo, di, uo) is det.
-:- mode map.foldr3(pred(in, in, di, uo, di, uo, di, uo) is det,
- in, di, uo, di, uo, di, uo) is det.
-
% Perform an inorder traversal of the map, applying an accumulator
% predicate with four accumulators for each key-value pair.
% (Although no more expressive than map.foldl, this is often
@@ -404,6 +369,58 @@
:- mode map.foldl4(pred(in, in, di, uo, di, uo, di, uo, di, uo) is det,
in, di, uo, di, uo, di, uo, di, uo) is det.
+ % Perform an inorder traversal of the map, applying
+ % an accumulator predicate for value.
+ %
+:- pred map.foldl_values(pred(V, A, A), map(K, V), A, A).
+:- mode map.foldl_values(pred(in, in, out) is det, in, in, out) is det.
+:- mode map.foldl_values(pred(in, mdi, muo) is det, in, mdi, muo) is det.
+:- mode map.foldl_values(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode map.foldl_values(pred(in, in, out) is semidet, in, in, out) is semidet.
+:- mode map.foldl_values(pred(in, mdi, muo) is semidet, in, mdi, muo)
+ is semidet.
+:- mode map.foldl_values(pred(in, di, uo) is semidet, in, di, uo) is semidet.
+:- mode map.foldl_values(pred(in, in, out) is cc_multi, in, in, out)
+ is cc_multi.
+:- mode map.foldl_values(pred(in, di, uo) is cc_multi, in, di, uo) is cc_multi.
+:- mode map.foldl_values(pred(in, mdi, muo) is cc_multi, in, mdi, muo)
+ is cc_multi.
+
+:- func map.foldr(func(K, V, A) = A, map(K, V), A) = A.
+:- pred map.foldr(pred(K, V, A, A), map(K, V), A, A).
+:- mode map.foldr(pred(in, in, in, out) is det, in, in, out) is det.
+:- mode map.foldr(pred(in, in, mdi, muo) is det, in, mdi, muo) is det.
+:- mode map.foldr(pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode map.foldr(pred(in, in, in, out) is semidet, in, in, out) is semidet.
+:- mode map.foldr(pred(in, in, mdi, muo) is semidet, in, mdi, muo) is semidet.
+:- mode map.foldr(pred(in, in, di, uo) is semidet, in, di, uo) is semidet.
+:- mode map.foldr(pred(in, in, in, out) is cc_multi, in, in, out) is cc_multi.
+:- mode map.foldr(pred(in, in, di, uo) is cc_multi, in, di, uo) is cc_multi.
+:- mode map.foldr(pred(in, in, mdi, muo) is cc_multi, in, mdi, muo)
+ is cc_multi.
+
+:- pred map.foldr2(pred(K, V, A, A, B, B), map(K, V), A, A, B, B).
+:- mode map.foldr2(pred(in, in, in, out, in, out) is det,
+ in, in, out, in, out) is det.
+:- mode map.foldr2(pred(in, in, in, out, in, out) is semidet,
+ in, in, out, in, out) is semidet.
+:- mode map.foldr2(pred(in, in, in, out, di, uo) is det,
+ in, in, out, di, uo) is det.
+:- mode map.foldr2(pred(in, in, di, uo, di, uo) is det,
+ in, di, uo, di, uo) is det.
+
+:- pred map.foldr3(pred(K, V, A, A, B, B, C, C), map(K, V), A, A, B, B, C, C).
+:- mode map.foldr3(pred(in, in, in, out, in, out, in, out) is det,
+ in, in, out, in, out, in, out) is det.
+:- mode map.foldr3(pred(in, in, in, out, in, out, in, out) is semidet,
+ in, in, out, in, out, in, out) is semidet.
+:- mode map.foldr3(pred(in, in, in, out, in, out, di, uo) is det,
+ in, in, out, in, out, di, uo) is det.
+:- mode map.foldr3(pred(in, in, in, out, di, uo, di, uo) is det,
+ in, in, out, di, uo, di, uo) is det.
+:- mode map.foldr3(pred(in, in, di, uo, di, uo, di, uo) is det,
+ in, di, uo, di, uo, di, uo) is det.
+
:- pred map.foldr4(pred(K, V, A, A, B, B, C, C, D, D), map(K, V),
A, A, B, B, C, C, D, D).
:- mode map.foldr4(pred(in, in, in, out, in, out, in, out, in, out) is det,
@@ -472,6 +489,45 @@
:- mode map.map_foldl3(pred(in, in, out, in, out, in, out, in, out) is semidet,
in, out, in, out, in, out, in, out) is semidet.
+ % As map.map_foldl, but without passing the key to the predicate.
+ %
+:- pred map.map_values_foldl(pred(V, W, A, A), map(K, V), map(K, W), A, A).
+:- mode map.map_values_foldl(pred(in, out, di, uo) is det,
+ in, out, di, uo) is det.
+:- mode map.map_values_foldl(pred(in, out, in, out) is det,
+ in, out, in, out) is det.
+:- mode map.map_values_foldl(pred(in, out, in, out) is semidet,
+ in, out, in, out) is semidet.
+
+ % As map.map_values_foldl, but with two accumulators.
+ %
+:- pred map.map_values_foldl2(pred(V, W, A, A, B, B), map(K, V), map(K, W),
+ A, A, B, B).
+:- mode map.map_values_foldl2(pred(in, out, di, uo, di, uo) is det,
+ in, out, di, uo, di, uo) is det.
+:- mode map.map_values_foldl2(pred(in, out, in, out, di, uo) is det,
+ in, out, in, out, di, uo) is det.
+:- mode map.map_values_foldl2(pred(in, out, in, out, in, out) is det,
+ in, out, in, out, in, out) is det.
+:- mode map.map_values_foldl2(pred(in, out, in, out, in, out) is semidet,
+ in, out, in, out, in, out) is semidet.
+
+ % As map.map_values_foldl, but with three accumulators.
+ %
+:- pred map.map_values_foldl3(pred(V, W, A, A, B, B, C, C),
+ map(K, V), map(K, W), A, A, B, B, C, C).
+:- mode map.map_values_foldl3(pred(in, out, di, uo, di, uo, di, uo) is det,
+ in, out, di, uo, di, uo, di, uo) is det.
+:- mode map.map_values_foldl3(pred(in, out, in, out, di, uo, di, uo) is det,
+ in, out, in, out, di, uo, di, uo) is det.
+:- mode map.map_values_foldl3(pred(in, out, in, out, in, out, di, uo) is det,
+ in, out, in, out, in, out, di, uo) is det.
+:- mode map.map_values_foldl3(pred(in, out, in, out, in, out, in, out) is det,
+ in, out, in, out, in, out, in, out) is det.
+:- mode map.map_values_foldl3(
+ pred(in, out, in, out, in, out, in, out) is semidet,
+ in, out, in, out, in, out, in, out) is semidet.
+
% Given two maps M1 and M2, create a third map M3 that has only the
% keys that occur in both M1 and M2. For keys that occur in both M1
% and M2, compute the value in the final map by applying the supplied
@@ -914,6 +970,9 @@
map.foldl4(Pred, Map, !A, !B, !C, !D) :-
tree234.foldl4(Pred, Map, !A, !B, !C, !D).
+map.foldl_values(Pred, Map, !A) :-
+ tree234.foldl_values(Pred, Map, !A).
+
map.foldr(Pred, Map, !A) :-
tree234.foldr(Pred, Map, !A).
@@ -934,14 +993,23 @@
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).
+map.map_foldl(Pred, !Map, !AccA) :-
+ tree234.map_foldl(Pred, !Map, !AccA).
+
+map.map_foldl2(Pred, !Map, !AccA, !AccB) :-
+ tree234.map_foldl2(Pred, !Map, !AccA, !AccB).
+
+map.map_foldl3(Pred, !Map, !AccA, !AccB, !AccC) :-
+ tree234.map_foldl3(Pred, !Map, !AccA, !AccB, !AccC).
+
+map.map_values_foldl(Pred, !Map, !AccA) :-
+ tree234.map_values_foldl(Pred, !Map, !AccA).
-map.map_foldl2(Pred, !Map, !Acc1, !Acc2) :-
- tree234.map_foldl2(Pred, !Map, !Acc1, !Acc2).
+map.map_values_foldl2(Pred, !Map, !AccA, !AccB) :-
+ tree234.map_values_foldl2(Pred, !Map, !AccA, !AccB).
-map.map_foldl3(Pred, !Map, !Acc1, !Acc2, !Acc3) :-
- tree234.map_foldl3(Pred, !Map, !Acc1, !Acc2, !Acc3).
+map.map_values_foldl3(Pred, !Map, !AccA, !AccB, !AccC) :-
+ tree234.map_values_foldl3(Pred, !Map, !AccA, !AccB, !AccC).
%-----------------------------------------------------------------------------%
Index: library/set_tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/set_tree234.m,v
retrieving revision 1.11
diff -u -b -r1.11 set_tree234.m
--- library/set_tree234.m 19 Aug 2009 07:31:53 -0000 1.11
+++ library/set_tree234.m 15 Sep 2009 10:18:03 -0000
@@ -42,7 +42,7 @@
%
:- pred set_tree234.empty(set_tree234(_T)::in) is semidet.
- % `set_tree234.member(X, Set)' is true iff `X' is a member of `Set'.
+ % `set_tree234.member(Set, X)' is true iff `X' is a member of `Set'.
%
:- pred set_tree234.member(set_tree234(T), T).
:- mode set_tree234.member(in, in) is semidet.
Index: library/tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.67
diff -u -b -r1.67 tree234.m
--- library/tree234.m 4 Sep 2009 02:53:36 -0000 1.67
+++ library/tree234.m 15 Sep 2009 02:45:30 -0000
@@ -189,6 +189,23 @@
:- mode tree234.foldl4(pred(in, in, di, uo, di, uo, di, uo, di, uo) is det,
in, di, uo, di, uo, di, uo, di, uo) is det.
+:- pred tree234.foldl_values(pred(V, A, A), tree234(K, V), A, A).
+:- mode tree234.foldl_values(pred(in, in, out) is det, in, in, out) is det.
+:- mode tree234.foldl_values(pred(in, mdi, muo) is det, in, mdi, muo) is det.
+:- mode tree234.foldl_values(pred(in, di, uo) is det, in, di, uo) is det.
+:- mode tree234.foldl_values(pred(in, in, out) is semidet, in, in, out)
+ is semidet.
+:- mode tree234.foldl_values(pred(in, mdi, muo) is semidet, in, mdi, muo)
+ is semidet.
+:- mode tree234.foldl_values(pred(in, di, uo) is semidet, in, di, uo)
+ is semidet.
+:- mode tree234.foldl_values(pred(in, in, out) is cc_multi, in, in, out)
+ is cc_multi.
+:- mode tree234.foldl_values(pred(in, di, uo) is cc_multi, in, di, uo)
+ is cc_multi.
+:- mode tree234.foldl_values(pred(in, mdi, muo) is cc_multi, in, mdi, muo)
+ is cc_multi.
+
:- func tree234.foldr(func(K, V, A) = A, tree234(K, V), A) = A.
:- pred tree234.foldr(pred(K, V, A, A), tree234(K, V), A, A).
@@ -294,6 +311,44 @@
is semidet,
in, out, in, out, in, out, in, out) is semidet.
+:- pred tree234.map_values_foldl(pred(V, W, A, A),
+ tree234(K, V), tree234(K, W), A, A).
+:- mode tree234.map_values_foldl(pred(in, out, di, uo) is det,
+ in, out, di, uo) is det.
+:- mode tree234.map_values_foldl(pred(in, out, in, out) is det,
+ in, out, in, out) is det.
+:- mode tree234.map_values_foldl(pred(in, out, in, out) is semidet,
+ in, out, in, out) is semidet.
+
+:- pred tree234.map_values_foldl2(pred(V, W, A, A, B, B),
+ tree234(K, V), tree234(K, W), A, A, B, B).
+:- mode tree234.map_values_foldl2(pred(in, out, di, uo, di, uo) is det,
+ in, out, di, uo, di, uo) is det.
+:- mode tree234.map_values_foldl2(pred(in, out, in, out, di, uo) is det,
+ in, out, in, out, di, uo) is det.
+:- mode tree234.map_values_foldl2(pred(in, out, in, out, in, out) is det,
+ in, out, in, out, in, out) is det.
+:- mode tree234.map_values_foldl2(pred(in, out, in, out, in, out) is semidet,
+ in, out, in, out, in, out) is semidet.
+
+:- pred tree234.map_values_foldl3(pred(V, W, A, A, B, B, C, C),
+ tree234(K, V), tree234(K, W), A, A, B, B, C, C).
+:- mode tree234.map_values_foldl3(
+ pred(in, out, di, uo, di, uo, di, uo) is det,
+ in, out, di, uo, di, uo, di, uo) is det.
+:- mode tree234.map_values_foldl3(
+ pred(in, out, in, out, di, uo, di, uo) is det,
+ in, out, in, out, di, uo, di, uo) is det.
+:- mode tree234.map_values_foldl3(
+ pred(in, out, in, out, in, out, di, uo) is det,
+ in, out, in, out, in, out, di, uo) is det.
+:- mode tree234.map_values_foldl3(
+ pred(in, out, in, out, in, out, in, out) is det,
+ in, out, in, out, in, out, in, out) is det.
+:- mode tree234.map_values_foldl3(
+ pred(in, out, in, out, in, out, in, out) is semidet,
+ in, out, in, out, in, out, in, out) is semidet.
+
% Convert a tree234 into a pretty_printer.doc. A tree mapping
% K1 to V1, K2 to V2, ... is formatted as
% "map([K1 -> V1, K2 -> V2, ...])". The functor "map" is used
@@ -2640,6 +2695,27 @@
Pred(K2, V2, !A, !B, !C, !D),
tree234.foldl4(Pred, T3, !A, !B, !C, !D).
+tree234.foldl_values(_Pred, empty, !A).
+tree234.foldl_values(Pred, two(_K, V, T0, T1), !A) :-
+ tree234.foldl_values(Pred, T0, !A),
+ Pred(V, !A),
+ tree234.foldl_values(Pred, T1, !A).
+tree234.foldl_values(Pred, three(_K0, V0, _K1, V1, T0, T1, T2), !A) :-
+ tree234.foldl_values(Pred, T0, !A),
+ Pred(V0, !A),
+ tree234.foldl_values(Pred, T1, !A),
+ Pred(V1, !A),
+ tree234.foldl_values(Pred, T2, !A).
+tree234.foldl_values(Pred, four(_K0, V0, _K1, V1, _K2, V2, T0, T1, T2, T3),
+ !A) :-
+ tree234.foldl_values(Pred, T0, !A),
+ Pred(V0, !A),
+ tree234.foldl_values(Pred, T1, !A),
+ Pred(V1, !A),
+ tree234.foldl_values(Pred, T2, !A),
+ Pred(V2, !A),
+ tree234.foldl_values(Pred, T3, !A).
+
%------------------------------------------------------------------------------%
tree234.foldr(_Pred, empty, !A).
@@ -2858,6 +2934,84 @@
tree234.map_foldl3(Pred, Right0, Right, !A, !B, !C),
Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+tree234.map_values_foldl(_Pred, empty, empty, !A).
+tree234.map_values_foldl(Pred, Tree0, Tree, !A) :-
+ Tree0 = two(K0, V0, Left0, Right0),
+ tree234.map_values_foldl(Pred, Left0, Left, !A),
+ Pred(V0, W0, !A),
+ tree234.map_values_foldl(Pred, Right0, Right, !A),
+ Tree = two(K0, W0, Left, Right).
+tree234.map_values_foldl(Pred, Tree0, Tree, !A) :-
+ Tree0 = three(K0, V0, K1, V1, Left0, Middle0, Right0),
+ tree234.map_values_foldl(Pred, Left0, Left, !A),
+ Pred(V0, W0, !A),
+ tree234.map_values_foldl(Pred, Middle0, Middle, !A),
+ Pred(V1, W1, !A),
+ tree234.map_values_foldl(Pred, Right0, Right, !A),
+ Tree = three(K0, W0, K1, W1, Left, Middle, Right).
+tree234.map_values_foldl(Pred, Tree0, Tree, !A) :-
+ Tree0 = four(K0, V0, K1, V1, K2, V2, Left0, LMid0, RMid0, Right0),
+ tree234.map_values_foldl(Pred, Left0, Left, !A),
+ Pred(V0, W0, !A),
+ tree234.map_values_foldl(Pred, LMid0, LMid, !A),
+ Pred(V1, W1, !A),
+ tree234.map_values_foldl(Pred, RMid0, RMid, !A),
+ Pred(V2, W2, !A),
+ tree234.map_values_foldl(Pred, Right0, Right, !A),
+ Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+
+tree234.map_values_foldl2(_Pred, empty, empty, !A, !B).
+tree234.map_values_foldl2(Pred, Tree0, Tree, !A, !B) :-
+ Tree0 = two(K0, V0, Left0, Right0),
+ tree234.map_values_foldl2(Pred, Left0, Left, !A, !B),
+ Pred(V0, W0, !A, !B),
+ tree234.map_values_foldl2(Pred, Right0, Right, !A, !B),
+ Tree = two(K0, W0, Left, Right).
+tree234.map_values_foldl2(Pred, Tree0, Tree, !A, !B) :-
+ Tree0 = three(K0, V0, K1, V1, Left0, Middle0, Right0),
+ tree234.map_values_foldl2(Pred, Left0, Left, !A, !B),
+ Pred(V0, W0, !A, !B),
+ tree234.map_values_foldl2(Pred, Middle0, Middle, !A, !B),
+ Pred(V1, W1, !A, !B),
+ tree234.map_values_foldl2(Pred, Right0, Right, !A, !B),
+ Tree = three(K0, W0, K1, W1, Left, Middle, Right).
+tree234.map_values_foldl2(Pred, Tree0, Tree, !A, !B) :-
+ Tree0 = four(K0, V0, K1, V1, K2, V2, Left0, LMid0, RMid0, Right0),
+ tree234.map_values_foldl2(Pred, Left0, Left, !A, !B),
+ Pred(V0, W0, !A, !B),
+ tree234.map_values_foldl2(Pred, LMid0, LMid, !A, !B),
+ Pred(V1, W1, !A, !B),
+ tree234.map_values_foldl2(Pred, RMid0, RMid, !A, !B),
+ Pred(V2, W2, !A, !B),
+ tree234.map_values_foldl2(Pred, Right0, Right, !A, !B),
+ Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+
+tree234.map_values_foldl3(_Pred, empty, empty, !A, !B, !C).
+tree234.map_values_foldl3(Pred, Tree0, Tree, !A, !B, !C) :-
+ Tree0 = two(K0, V0, Left0, Right0),
+ tree234.map_values_foldl3(Pred, Left0, Left, !A, !B, !C),
+ Pred(V0, W0, !A, !B, !C),
+ tree234.map_values_foldl3(Pred, Right0, Right, !A, !B, !C),
+ Tree = two(K0, W0, Left, Right).
+tree234.map_values_foldl3(Pred, Tree0, Tree, !A, !B, !C) :-
+ Tree0 = three(K0, V0, K1, V1, Left0, Middle0, Right0),
+ tree234.map_values_foldl3(Pred, Left0, Left, !A, !B, !C),
+ Pred(V0, W0, !A, !B, !C),
+ tree234.map_values_foldl3(Pred, Middle0, Middle, !A, !B, !C),
+ Pred(V1, W1, !A, !B, !C),
+ tree234.map_values_foldl3(Pred, Right0, Right, !A, !B, !C),
+ Tree = three(K0, W0, K1, W1, Left, Middle, Right).
+tree234.map_values_foldl3(Pred, Tree0, Tree, !A, !B, !C) :-
+ Tree0 = four(K0, V0, K1, V1, K2, V2, Left0, LMid0, RMid0, Right0),
+ tree234.map_values_foldl3(Pred, Left0, Left, !A, !B, !C),
+ Pred(V0, W0, !A, !B, !C),
+ tree234.map_values_foldl3(Pred, LMid0, LMid, !A, !B, !C),
+ Pred(V1, W1, !A, !B, !C),
+ tree234.map_values_foldl3(Pred, RMid0, RMid, !A, !B, !C),
+ Pred(V2, W2, !A, !B, !C),
+ tree234.map_values_foldl3(Pred, Right0, Right, !A, !B, !C),
+ Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+
%------------------------------------------------------------------------------%
tree234.count(empty, 0).
Index: library/varset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/varset.m,v
retrieving revision 1.83
diff -u -b -r1.83 varset.m
--- library/varset.m 3 Sep 2009 23:07:33 -0000 1.83
+++ library/varset.m 15 Sep 2009 04:07:30 -0000
@@ -406,19 +406,7 @@
).
varset.search_name(varset(_, Names, _), Id, Name) :-
- map.search(Names, Id, Name0),
- Name = Name0.
-% This part is useful during debugging when you need to
-% be able to distinguish different variables with the same name.
-% (
-% map.member(Names, Id1, Name0),
-% Id1 \= Id
-% ->
-% term.var_to_int(Id, Int),
-% string.format("%s.%d",[s(Name0),i(Int)], Name)
-% ;
-% Name = Name0
-% ).
+ map.search(Names, Id, Name).
%-----------------------------------------------------------------------------%
@@ -659,10 +647,11 @@
%-----------------------------------------------------------------------------%
-varset.select(varset(Supply, VarNameMap0, Values0), Vars,
- varset(Supply, VarNameMap, Values)) :-
+varset.select(VarSet0, Vars, VarSet) :-
+ VarSet0 = varset(Supply, VarNameMap0, Values0),
map.select(VarNameMap0, Vars, VarNameMap),
- map.select(Values0, Vars, Values).
+ map.select(Values0, Vars, Values),
+ VarSet = varset(Supply, VarNameMap, Values).
%-----------------------------------------------------------------------------%
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