[m-dev.] for review: reordering for existential types [1]
Fergus Henderson
fjh at cs.mu.OZ.AU
Fri Jun 11 01:49:26 AEST 1999
Hi all,
My recent work on improving the support for existential types
has reached the point of stability at which it may be useful
for others, e.g. DJ, to have access to this. But it is not
yet stable enough to commit on the main branch. In particular,
although it does bootstrap, it still fails many of the tests.
So I'm going to commit this on a branch (`existential_types_2')
for now.
The nature of this change made it necessary to break many of
the invariants that various parts of the compiler depended on,
and there's really no easy way to track down all of the problems
that this has caused -- the only way that works is doing lots
of testing and debugging. So I imagine it will take me quite
some time to get all the bugs out.
If anyone wants review this now, I'd appreciate their comments.
--------------------
Estimated hours taken: 80
Change the order of the passes so that polymorphism comes before
mode analysis. This is necessary so that mode analysis can properly
reorder code involving existential types.
compiler/notes/compiler_design.html:
Document the new pass ordering.
compiler/mercury_compile.m:
Invoke polymorphism.m before mode-checking.
Invoke lambda.m where polymorphism used to be invoked,
since polymorphism no longer invokes lambda.m now.
compiler/post_typecheck.m:
Don't invoke copy_clauses_to_procs, because that is done by
polymorphism.m now.
compiler/polymorphism.m:
Don't invoke lambda.m, because that is done by mercury_compile.m now.
Delete the code for calculating the typeclass constraints
on lambda expressions -- this is now done in lambda.m.
Change this pass so that it now processes the clauses_info
and the proc_info, calling copy_clause_to_proc for each procedure,
rather than just processing the proc_infos. This is needed so
that unify_proc__request_proc can copy the clauses_info into the
proc_info when creating new modes, without needing to rerun
polymorphism (the polymorphism pass was not designed to be rerun).
Don't bother setting up the instmap_delta or determinism fields
in the goal_info, since they will be computed by later passes
(mode analysis and determinism analysis) now.
Add code to convert function calls into predicate calls
(and higher-order function calls into higher-order predicate calls),
adapted from the code to do that in modecheck_unify.m.
Likewise add code to convert higher-order terms into
lambda expressions.
Don't convert complicated unifications into procedure calls,
since at this point in the complication we don't yet know whether
var-var unifications are complicated unifications or assignments.
Instead, just compute the type_infos that would be needed if the
unification does turn out to be a complicated unification, and
save this information in the HLDS for use by quantification.m
and modecheck_unify.m.
Store the pred_info rather than just the pred_name in the
poly_info. Delete the aditi_owner and pred_markers fields from
the poly_info, since they are no longer needed.
Rename init_poly_info as create_poly_info, to improve consistency
with {pred,proc}_info_{init,create}. Create a new init_poly_info
function with a slightly different interface (it takes a
clauses_info rather than a proc_info).
compiler/magic.m:
s/init_poly_info/create_poly_info/
compiler/simplify.m:
Convert complicated unifications into procedure calls.
Re-enable the optimization of replacing goals with no output
variables with `true', since it should work OK even for
existentially type predicates now that the polymorphism pass
comes before simplify.m.
compiler/lambda.m:
Add lambda__process_module for processing a whole module.
Calculate the typeclass constraints on lambda expressions
properly, using code adapted from polymorphism.m.
compiler/hlds_goal.m:
Add new field to the `complicated_unify' functor to hold the
type_info variables needed for a complicated unification,
so that these can be set by polymorphism.m and used
by modecheck_unify.m and quantification.
compiler/quantification.m:
Include the new type_info variables field in the nonlocals for a
complicated unify.
compiler/modecheck_unify.m:
Delete the code to convert function calls into predicate
calls, since that is now done by polymorphism.m.
Change create_var_var_unification so that it fills in the new
type_info vars field properly.
Make categorize_unify_var_var local rather than exported,
because it is not used outside this module, and because
I had to change the interface slightly so that it preserves
the value of the new field.
Split the checking of complicated unifications in
categorize_unify_var_var into a new predicate
modecheck_complicated_unify.
Add code to check that the type_info vars for complicated unifies
(which it obtains from the new field) are ground.
compiler/modes.m:
Don't try to modecheck typeclass methods, because they're created
already mode-correct, and because the code to modecheck them
has not been written (modecheck_goal_expr just calls error/1).
Previously, typeclass methods didn't exist at mode analysis time,
since they're created by polymorphism.m, but now they do exist at
mode analysis time and so we have to explicitly check for them.
compiler/unify_proc.m:
When computing modes for new unification procedures, make sure
that we add extra modes for any typeinfos needed, if the type
is polymorphic.
compiler/hlds_out.m
Add code to print the new field of complicated_unifies.
compiler/bytecode_gen.m:
compiler/code_util.m:
compiler/common.m:
compiler/dependency_graph.m:
compiler/det_analysis.m:
compiler/follow_code.m:
compiler/follow_vars.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_goal.m:
compiler/live_vars.m:
compiler/make_hlds.m:
compiler/mercury_to_c.m:
compiler/modecheck_unify.m:
compiler/pd_cost.m:
compiler/polymorphism.m:
compiler/rl_exprn.m:
compiler/rl_key.m:
compiler/simplify.m:
compiler/term_traversal.m:
compiler/unify_gen.m:
compiler/unused_args.m:
Trivial changes to handle the new field of complicated_unifies.
compiler/hlds_pred.m:
Define and use typedefs `type_info_varmap', `type_class_info_varmap',
and `constraint_proof_map', rather than duplicating complicated
map(...) types everywhere.
Add two new fields to the clauses_info data structure:
a type_info_varmap and a type_class_info_varmap.
Define access predicates for the clauses_info data structure.
Add type_info_varmap and type_class_info_varmap as extra
arguments to proc_info_set_body.
compiler/check_typeclass.m:
compiler/clause_to_proc.m:
compiler/dead_proc_elim.m:
compiler/higher_order.m:
compiler/hlds_out.m:
compiler/hlds_pred.m:
compiler/intermod.m:
compiler/make_hlds.m:
compiler/mercury_to_c.m:
compiler/modes.m:
compiler/polymorphism.m:
compiler/post_typecheck.m:
compiler/purity.m:
compiler/typecheck.m:
compiler/unify_proc.m:
Trivial changes to handle the two new fields of clauses_info.
Change many places to use the the access predicates to access
fields of the clauses_info rather than accessing them directly.
compiler/purity.m:
Fix some non-standard layout to match our usual coding conventions.
XXX TODO:
- termination analysis doesn't work; probably some mixup
regarding whether or not the pragmas in the .opt and
.trans_opt files are supposed to have the type_infos
included or not.
- fixup error messages (argument numbers offset)
- quite a few test cases are failing
Workspace: /home/mercury0/fjh/mercury-other
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.43
diff -u -r1.43 bytecode_gen.m
--- bytecode_gen.m 1999/06/01 09:43:34 1.43
+++ bytecode_gen.m 1999/06/08 00:42:32
@@ -465,7 +465,7 @@
bytecode_gen__map_var(ByteInfo, Var1, ByteVar1),
bytecode_gen__map_var(ByteInfo, Var2, ByteVar2),
Code = node([test(ByteVar1, ByteVar2)]).
-bytecode_gen__unify(complicated_unify(_, _), _Var, _RHS, _ByteInfo, _Code) :-
+bytecode_gen__unify(complicated_unify(_,_,_), _Var, _RHS, _ByteInfo, _Code) :-
error("complicated unifications should have been handled by polymorphism.m").
:- pred bytecode_gen__map_uni_modes(list(uni_mode)::in, list(prog_var)::in,
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.24
diff -u -r1.24 check_typeclass.m
--- check_typeclass.m 1999/06/01 09:43:37 1.24
+++ check_typeclass.m 1999/06/09 11:39:42
@@ -524,11 +524,13 @@
varset__init(VarSet0),
make_n_fresh_vars("HeadVar__", PredArity, VarSet0, HeadVars, VarSet),
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
- DummyClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars,
- DummyClause),
+ map__init(TI_VarMap),
+ map__init(TCI_VarMap),
+ ClausesInfo0 = clauses_info(VarSet, VarTypes, VarTypes, HeadVars,
+ DummyClause, TI_VarMap, TCI_VarMap),
pred_info_init(ModuleName, PredName, PredArity, ArgTypeVars,
- ExistQVars, ArgTypes, Cond, Context, DummyClausesInfo, Status,
+ ExistQVars, ArgTypes, Cond, Context, ClausesInfo0, Status,
Markers, none, PredOrFunc, ClassContext, Proofs, User,
PredInfo0),
@@ -572,8 +574,7 @@
IntroducedGoal = IntroducedGoalExpr - GoalInfo
),
IntroducedClause = clause(InstanceProcIds, IntroducedGoal, Context),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars,
- [IntroducedClause]),
+ clauses_info_set_clauses(ClausesInfo0, [IntroducedClause], ClausesInfo),
pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo),
module_info_get_predicate_table(ModuleInfo0, PredicateTable0),
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.24
diff -u -r1.24 clause_to_proc.m
--- clause_to_proc.m 1999/06/01 09:43:38 1.24
+++ clause_to_proc.m 1999/06/09 10:24:15
@@ -131,7 +131,8 @@
copy_clauses_to_procs_2(ProcIds, ClausesInfo, Procs1, Procs).
copy_clauses_to_proc(ProcId, ClausesInfo, Proc0, Proc) :-
- ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses),
+ ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses,
+ TI_VarMap, TCI_VarMap),
select_matching_clauses(Clauses, ProcId, MatchingClauses),
get_clause_goals(MatchingClauses, GoalList),
( GoalList = [SingleGoal] ->
@@ -181,7 +182,8 @@
map__init(Empty),
Goal = disj(GoalList, Empty) - GoalInfo
),
- proc_info_set_body(Proc0, VarSet, VarTypes, HeadVars, Goal, Proc).
+ proc_info_set_body(Proc0, VarSet, VarTypes, HeadVars, Goal,
+ TI_VarMap, TCI_VarMap, Proc).
:- pred get_purity(hlds_goal, purity).
:- mode get_purity(in, out) is det.
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.108
diff -u -r1.108 code_util.m
--- code_util.m 1999/04/30 06:19:16 1.108
+++ code_util.m 1999/06/03 17:25:33
@@ -746,7 +746,7 @@
:- mode code_util__cannot_stack_flush_2(in) is semidet.
code_util__cannot_stack_flush_2(unify(_, _, _, Unify, _)) :-
- Unify \= complicated_unify(_, _).
+ Unify \= complicated_unify(_, _, _).
code_util__cannot_stack_flush_2(call(_, _, _, BuiltinState, _, _)) :-
BuiltinState = inline_builtin.
code_util__cannot_stack_flush_2(conj(Goals)) :-
Index: compiler/common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.52
diff -u -r1.52 common.m
--- common.m 1998/11/20 04:07:13 1.52
+++ common.m 1999/06/03 17:25:38
@@ -180,7 +180,7 @@
common__record_equivalence(Var1, Var2, Info0, Info),
GoalInfo = GoalInfo0
;
- Unification0 = complicated_unify(_, _),
+ Unification0 = complicated_unify(_, _, _),
Goal = Goal0,
Info = Info0,
GoalInfo = GoalInfo0
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.46
diff -u -r1.46 dead_proc_elim.m
--- dead_proc_elim.m 1999/04/23 01:02:36 1.46
+++ dead_proc_elim.m 1999/06/09 10:24:29
@@ -788,7 +788,7 @@
Needed, NeededNames),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
- ClausesInfo = clauses_info(_,_,_,_, Clauses),
+ clauses_info_clauses(ClausesInfo, Clauses),
list__foldl(dead_pred_elim_process_clause, Clauses,
DeadInfo1, DeadInfo2)
),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.40
diff -u -r1.40 dependency_graph.m
--- dependency_graph.m 1999/03/22 08:07:07 1.40
+++ dependency_graph.m 1999/06/03 17:25:43
@@ -271,7 +271,7 @@
; Unify = deconstruct(_, Cons, _, _, _),
dependency_graph__add_arcs_in_cons(Cons, Caller,
DepGraph0, DepGraph)
- ; Unify = complicated_unify(_, _),
+ ; Unify = complicated_unify(_, _, _),
DepGraph0 = DepGraph
).
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.138
diff -u -r1.138 det_analysis.m
--- det_analysis.m 1998/11/20 04:07:23 1.138
+++ det_analysis.m 1999/06/03 17:26:04
@@ -925,7 +925,7 @@
det_infer_unify_examines_rep(construct(_, _, _, _), no).
det_infer_unify_examines_rep(deconstruct(_, _, _, _, _), yes).
det_infer_unify_examines_rep(simple_test(_, _), yes).
-det_infer_unify_examines_rep(complicated_unify(_, _), no).
+det_infer_unify_examines_rep(complicated_unify(_, _, _), no).
% Some complicated modes of complicated unifications _do_
% examine the representation...
% but we will catch those by reporting errors in the
@@ -949,7 +949,7 @@
det_infer_unify_canfail(assign(_, _), cannot_fail).
det_infer_unify_canfail(construct(_, _, _, _), cannot_fail).
det_infer_unify_canfail(simple_test(_, _), can_fail).
-det_infer_unify_canfail(complicated_unify(_, CanFail), CanFail).
+det_infer_unify_canfail(complicated_unify(_, CanFail, _), CanFail).
%-----------------------------------------------------------------------------%
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.50
diff -u -r1.50 follow_code.m
--- follow_code.m 1998/11/20 04:07:39 1.50
+++ follow_code.m 1999/06/03 17:26:11
@@ -312,7 +312,7 @@
:- mode move_follow_code_is_builtin(in) is semidet.
move_follow_code_is_builtin(unify(_, _, _, Unification, _) - _GoalInfo) :-
- Unification \= complicated_unify(_, _).
+ Unification \= complicated_unify(_, _, _).
move_follow_code_is_builtin(call(_, _, _, Builtin, _, _) - _GoalInfo) :-
Builtin = inline_builtin.
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_vars.m,v
retrieving revision 1.52
diff -u -r1.52 follow_vars.m
--- follow_vars.m 1999/06/01 09:43:43 1.52
+++ follow_vars.m 1999/06/08 00:42:34
@@ -342,7 +342,7 @@
BuiltinState = inline_builtin
;
GoalExpr0 = unify(_, _, _, Unification, _),
- Unification \= complicated_unify(_, _)
+ Unification \= complicated_unify(_, _, _)
)
->
AttachToNext = no
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.50
diff -u -r1.50 goal_util.m
--- goal_util.m 1998/12/06 23:43:12 1.50
+++ goal_util.m 1999/06/03 17:26:36
@@ -390,8 +390,9 @@
goal_util__rename_unify(simple_test(L0, R0), Must, Subn, simple_test(L, R)) :-
goal_util__rename_var(L0, Must, Subn, L),
goal_util__rename_var(R0, Must, Subn, R).
-goal_util__rename_unify(complicated_unify(Modes, Cat), _Must, _Subn,
- complicated_unify(Modes, Cat)).
+goal_util__rename_unify(complicated_unify(Modes, Cat, TypeInfoVars),
+ _Must, _Subn,
+ complicated_unify(Modes, Cat, TypeInfoVars)).
%-----------------------------------------------------------------------------%
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.51
diff -u -r1.51 higher_order.m
--- higher_order.m 1999/04/23 01:02:40 1.51
+++ higher_order.m 1999/06/09 10:24:59
@@ -607,7 +607,7 @@
Info = info(PredVars, Requests, NewPreds, PredProcId,
PredInfo, ProcInfo, ModuleInfo, Params, Changed).
-check_unify(complicated_unify(_, _)) -->
+check_unify(complicated_unify(_, _, _)) -->
{ error("higher_order:check_unify - complicated unification") }.
:- pred is_interesting_cons_id(ho_params::in, cons_id::in) is semidet.
@@ -1748,11 +1748,13 @@
varset__init(EmptyVarSet),
map__init(EmptyVarTypes),
map__init(EmptyProofs),
+ map__init(EmptyTIMap),
+ map__init(EmptyTCIMap),
% This isn't looked at after here, and just clutters up
% hlds dumps if it's filled in.
ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
- EmptyVarTypes, [], []),
+ EmptyVarTypes, [], [], EmptyTIMap, EmptyTCIMap),
pred_info_init(PredModule, SymName, Arity, ArgTVarSet, ExistQVars,
Types, true, Context, ClausesInfo, Status, MarkerList, GoalType,
PredOrFunc, ClassContext, EmptyProofs, Owner, PredInfo1),
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.59
diff -u -r1.59 hlds_goal.m
--- hlds_goal.m 1999/04/23 01:02:41 1.59
+++ hlds_goal.m 1999/06/10 14:11:30
@@ -310,7 +310,19 @@
; complicated_unify(
uni_mode, % The mode of the unification.
- can_fail % Whether or not it could possibly fail
+ can_fail, % Whether or not it could possibly fail
+ list(prog_var) % The type_info variables needed
+ % by this unification, if ends up
+ % being a complicated unify.
+ % This field is set by polymorphism.m.
+ % It is used by quantification.m
+ % when recomputing the nonlocals.
+ % It is also used by modecheck_unify.m,
+ % which checks that the type_info
+ % variables needed are all ground.
+ % It is also checked by simplify.m when
+ % it converts complicated unifications
+ % into procedure calls.
).
% A unify_context describes the location in the original source
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.220
diff -u -r1.220 hlds_out.m
--- hlds_out.m 1999/06/09 16:39:31 1.220
+++ hlds_out.m 1999/06/10 14:12:21
@@ -542,7 +542,8 @@
;
[]
),
- { ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses) },
+ { ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses,
+ TypeInfoMap, TypeClassInfoMap) },
( { string__contains_char(Verbose, 'C') } ->
hlds_out__write_indent(Indent),
io__write_string("% pred id: "),
@@ -561,6 +562,10 @@
hlds_out__write_marker_list(MarkerList),
io__write_string("\n")
),
+ hlds_out__write_typeinfo_varmap(Indent, AppendVarnums,
+ TypeInfoMap, VarSet, TVarSet),
+ hlds_out__write_typeclass_info_varmap(Indent, AppendVarnums,
+ TypeClassInfoMap, VarSet, TVarSet),
( { map__is_empty(Proofs) } ->
[]
;
@@ -568,6 +573,12 @@
Proofs),
io__write_string("\n")
),
+
+ % XXX The indexes are not part of the clauses_info,
+ % so why is this code inside this if-then-else
+ % with the condition `string__contains_char(Verbose, 'C')'?
+ % Shouldn't it be dependent on a different letter?
+
( { Indexes = [] } ->
[]
;
@@ -1262,9 +1273,11 @@
(
% don't output bogus info if we haven't been through
% mode analysis yet
- { Unification = complicated_unify(Mode, CanFail) },
+ { Unification = complicated_unify(Mode, CanFail,
+ TypeInfoVars) },
{ CanFail = can_fail },
- { Mode = (free - free -> free - free) }
+ { Mode = (free - free -> free - free) },
+ { TypeInfoVars = [] }
->
[]
;
@@ -1406,8 +1419,8 @@
!,
hlds_out_write_functor_and_submodes(ConsId, ArgVars, ArgModes,
ModuleInfo, ProgVarSet, InstVarSet, AppendVarnums, Indent).
-hlds_out__write_unification(complicated_unify(Mode, CanFail),
- _ModuleInfo, _ProgVarSet, InstVarSet, _, Indent) -->
+hlds_out__write_unification(complicated_unify(Mode, CanFail, TypeInfoVars),
+ _ModuleInfo, ProgVarSet, InstVarSet, AppendVarNums, Indent) -->
hlds_out__write_indent(Indent),
io__write_string("% "),
( { CanFail = can_fail },
@@ -1418,7 +1431,12 @@
!,
io__write_string("mode: "),
mercury_output_uni_mode(Mode, InstVarSet),
+ io__write_string("\n"),
+ hlds_out__write_indent(Indent),
+ io__write_string("% type-info vars: "),
+ mercury_output_vars(TypeInfoVars, ProgVarSet, AppendVarNums),
io__write_string("\n").
+
:- pred hlds_out_write_functor_and_submodes(cons_id, list(prog_var),
list(uni_mode), module_info, prog_varset, inst_varset,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.58
diff -u -r1.58 hlds_pred.m
--- hlds_pred.m 1999/06/01 09:43:51 1.58
+++ hlds_pred.m 1999/06/10 14:15:31
@@ -81,6 +81,8 @@
:- type pred_proc_id ---> proc(pred_id, proc_id).
:- type pred_proc_list == list(pred_proc_id).
+%-----------------------------------------------------------------------------%
+
% The clauses_info structure contains the clauses for a predicate
% after conversion from the item_list by make_hlds.m.
% Typechecking is performed on the clauses info, then the clauses
@@ -97,9 +99,70 @@
% variable types
% inferred by typecheck.m.
list(prog_var), % head vars
- list(clause)
+ list(clause),
+ % the following two fields
+ % are computed by
+ % polymorphism.m
+ type_info_varmap,
+ typeclass_info_varmap
).
+:- pred clauses_info_varset(clauses_info, prog_varset).
+:- mode clauses_info_varset(in, out) is det.
+
+ % This partial map holds the types specified by any explicit
+ % type qualifiers in the clauses.
+:- pred clauses_info_explicit_vartypes(clauses_info, map(prog_var, type)).
+:- mode clauses_info_explicit_vartypes(in, out) is det.
+
+ % This map contains the types of all the variables, as inferred
+ % by typecheck.m.
+:- pred clauses_info_vartypes(clauses_info, map(prog_var, type)).
+:- mode clauses_info_vartypes(in, out) is det.
+
+:- pred clauses_info_type_info_varmap(clauses_info, type_info_varmap).
+:- mode clauses_info_type_info_varmap(in, out) is det.
+
+:- pred clauses_info_typeclass_info_varmap(clauses_info,
+ typeclass_info_varmap).
+:- mode clauses_info_typeclass_info_varmap(in, out) is det.
+
+:- pred clauses_info_headvars(clauses_info, list(prog_var)).
+:- mode clauses_info_headvars(in, out) is det.
+
+:- pred clauses_info_clauses(clauses_info, list(clause)).
+:- mode clauses_info_clauses(in, out) is det.
+
+:- pred clauses_info_set_headvars(clauses_info, list(prog_var), clauses_info).
+:- mode clauses_info_set_headvars(in, in, out) is det.
+
+:- pred clauses_info_set_clauses(clauses_info, list(clause), clauses_info).
+:- mode clauses_info_set_clauses(in, in, out) is det.
+
+:- pred clauses_info_set_varset(clauses_info, prog_varset, clauses_info).
+:- mode clauses_info_set_varset(in, in, out) is det.
+
+ % This partial map holds the types specified by any explicit
+ % type qualifiers in the clauses.
+:- pred clauses_info_set_explicit_vartypes(clauses_info, map(prog_var, type),
+ clauses_info).
+:- mode clauses_info_set_explicit_vartypes(in, in, out) is det.
+
+ % This map contains the types of all the variables, as inferred
+ % by typecheck.m.
+:- pred clauses_info_set_vartypes(clauses_info, map(prog_var, type),
+ clauses_info).
+:- mode clauses_info_set_vartypes(in, in, out) is det.
+
+:- pred clauses_info_set_type_info_varmap(clauses_info, type_info_varmap,
+ clauses_info).
+:- mode clauses_info_set_type_info_varmap(in, in, out) is det.
+
+:- pred clauses_info_set_typeclass_info_varmap(clauses_info,
+ typeclass_info_varmap, clauses_info).
+:- mode clauses_info_set_typeclass_info_varmap(in, in, out) is det.
+
+
:- type clause ---> clause(
list(proc_id), % modes for which
% this clause applies
@@ -110,6 +173,8 @@
prog_context
).
+%-----------------------------------------------------------------------------%
+
% The type of goals that have been given for a pred.
:- type goal_type ---> pragmas % pragma c_code(...)
@@ -320,6 +385,22 @@
% module, name and arity.
:- type aditi_owner == string.
+ % The constraint_proof_map is a map which for each type class
+ % constraint records how/why that constraint was satisfied.
+ % This information is used to determine how to construct the
+ % typeclass_info for that constraint.
+:- type constraint_proof_map == map(class_constraint, constraint_proof).
+
+ % A typeclass_info_varmap is a map which for each type class constraint
+ % records which variable contains the typeclass_info for that
+ % constraint.
+:- type typeclass_info_varmap == map(class_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.
+:- type type_info_varmap == map(tvar, type_info_locn).
+
+ % A type_info_locn specifies how to access a type_info.
:- type type_info_locn
---> type_info(prog_var)
% It is a normal type_info, i.e. the type
@@ -359,10 +440,9 @@
% which were added to the front of the argument list.
:- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(prog_var),
list(prog_var), instmap, string, tvarset, map(prog_var, type),
- class_constraints, map(tvar, type_info_locn),
- map(class_constraint, prog_var), prog_varset, pred_markers,
- aditi_owner, is_address_taken, module_info, module_info,
- pred_proc_id).
+ class_constraints, type_info_varmap, typeclass_info_varmap,
+ prog_varset, pred_markers, aditi_owner, is_address_taken,
+ module_info, module_info, pred_proc_id).
:- mode hlds_pred__define_new_pred(in, out, in, out, in, in, in, in, in,
in, in, in, in, in, in, in, out, out) is det.
@@ -372,7 +452,7 @@
:- pred pred_info_init(module_name, sym_name, arity, tvarset, existq_tvars,
list(type), condition, prog_context, clauses_info, import_status,
pred_markers, goal_type, pred_or_func, class_constraints,
- map(class_constraint, constraint_proof), aditi_owner, pred_info).
+ constraint_proof_map, aditi_owner, pred_info).
:- mode pred_info_init(in, in, in, in, in, in, in, in, in, in, in, in, in,
in, in, in, out) is det.
@@ -518,12 +598,11 @@
:- pred pred_info_set_class_context(pred_info, class_constraints, pred_info).
:- mode pred_info_set_class_context(in, in, out) is det.
-:- pred pred_info_get_constraint_proofs(pred_info,
- map(class_constraint, constraint_proof)).
+:- pred pred_info_get_constraint_proofs(pred_info, constraint_proof_map).
:- mode pred_info_get_constraint_proofs(in, out) is det.
-:- pred pred_info_set_constraint_proofs(pred_info,
- map(class_constraint, constraint_proof), pred_info).
+:- pred pred_info_set_constraint_proofs(pred_info, constraint_proof_map,
+ pred_info).
:- mode pred_info_set_constraint_proofs(in, in, out) is det.
:- pred pred_info_get_aditi_owner(pred_info, string).
@@ -667,7 +746,7 @@
% the class constraints on the
% type variables in the predicate's
% type declaration
- map(class_constraint, constraint_proof),
+ constraint_proof_map,
% explanations of how redundant
% constraints were eliminated. These
% are needed by polymorphism.m to
@@ -734,9 +813,13 @@
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
+ proc_info_typeclass_info_varmap(ProcInfo, TypeClassInfoMap),
unqualify_name(SymName, PredName),
% The empty list of clauses is a little white lie.
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, []),
+ Clauses = [],
+ ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars,
+ Clauses, TypeInfoMap, TypeClassInfoMap),
map__init(ClassProofs),
term__vars_list(Types, TVars),
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
@@ -1040,6 +1123,49 @@
%-----------------------------------------------------------------------------%
+% :- type clauses_info ---> clauses_info(
+% prog_varset, % variable names
+% map(prog_var, type),
+% % variable types from
+% % explicit qualifications
+% map(prog_var, type),
+% % variable types
+% % inferred by typecheck.m.
+% list(prog_var), % head vars
+% list(clause),
+% type_info_varmap,
+% typeclass_info_varmap,
+% ).
+
+clauses_info_varset(clauses_info(VarSet, _, _, _, _, _, _), VarSet).
+clauses_info_explicit_vartypes(
+ clauses_info(_, ExplicitVarTypes, _, _, _, _, _), ExplicitVarTypes).
+clauses_info_vartypes(clauses_info(_, _, VarTypes, _, _, _, _), VarTypes).
+clauses_info_headvars(clauses_info(_, _, _, HeadVars, _, _, _), HeadVars).
+clauses_info_clauses(clauses_info(_, _, _, _, Clauses, _, _), Clauses).
+clauses_info_type_info_varmap(clauses_info(_, _, _, _, _, TIMap, _), TIMap).
+clauses_info_typeclass_info_varmap(clauses_info(_, _, _, _, _, _, TCIMap),
+ TCIMap).
+
+clauses_info_set_varset(clauses_info(_, B, C, D, E, F, G), VarSet,
+ clauses_info(VarSet, B, C, D, E, F, G)).
+clauses_info_set_explicit_vartypes(clauses_info(A, _, C, D, E, F, G),
+ ExplicitVarTypes,
+ clauses_info(A, ExplicitVarTypes, C, D, E, F, G)).
+clauses_info_set_vartypes(clauses_info(A, B, _, D, E, F, G), VarTypes,
+ clauses_info(A, B, VarTypes, D, E, F, G)).
+clauses_info_set_headvars(clauses_info(A, B, C, _, E, F, G), HeadVars,
+ clauses_info(A, B, C, HeadVars, E, F, G)).
+clauses_info_set_clauses(clauses_info(A, B, C, D, _, F, G), Clauses,
+ clauses_info(A, B, C, D, Clauses, F, G)).
+clauses_info_set_type_info_varmap(clauses_info(A, B, C, D, E, _, G), TIMap,
+ clauses_info(A, B, C, D, E, TIMap, G)).
+clauses_info_set_typeclass_info_varmap(clauses_info(A, B, C, D, E, F, _),
+ TCIMap,
+ clauses_info(A, B, C, D, E, F, TCIMap)).
+
+%-----------------------------------------------------------------------------%
+
hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap,
VarSet0, Markers, Owner, IsAddressTaken,
@@ -1143,21 +1269,21 @@
:- pred proc_info_set(maybe(determinism), prog_varset, map(prog_var, type),
list(prog_var), list(mode), maybe(list(is_live)), hlds_goal,
prog_context, stack_slots, determinism, bool, list(arg_info),
- liveness_info, map(tvar, type_info_locn),
- map(class_constraint, prog_var), maybe(arg_size_info),
- maybe(termination_info), is_address_taken, proc_info).
+ liveness_info, type_info_varmap, typeclass_info_varmap,
+ maybe(arg_size_info), maybe(termination_info), is_address_taken,
+ proc_info).
:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
in, in, in, in, out) is det.
:- pred proc_info_create(prog_varset, map(prog_var, type), list(prog_var),
list(mode), determinism, hlds_goal, prog_context,
- map(tvar, type_info_locn), map(class_constraint, prog_var),
- is_address_taken, proc_info).
+ type_info_varmap, typeclass_info_varmap, is_address_taken, proc_info).
:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, out) is det.
:- pred proc_info_set_body(proc_info, prog_varset, map(prog_var, type),
- list(prog_var), hlds_goal, proc_info).
-:- mode proc_info_set_body(in, in, in, in, in, out) is det.
+ list(prog_var), hlds_goal, type_info_varmap,
+ typeclass_info_varmap, proc_info).
+:- mode proc_info_set_body(in, in, in, in, in, in, in, out) is det.
:- pred proc_info_declared_determinism(proc_info, maybe(determinism)).
:- mode proc_info_declared_determinism(in, out) is det.
@@ -1266,11 +1392,10 @@
:- pred proc_info_set_can_process(proc_info, bool, proc_info).
:- mode proc_info_set_can_process(in, in, out) is det.
-:- pred proc_info_typeinfo_varmap(proc_info, map(tvar, type_info_locn)).
+:- pred proc_info_typeinfo_varmap(proc_info, type_info_varmap).
:- mode proc_info_typeinfo_varmap(in, out) is det.
-:- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, type_info_locn),
- proc_info).
+:- pred proc_info_set_typeinfo_varmap(proc_info, type_info_varmap, proc_info).
:- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
:- pred proc_info_eval_method(proc_info, eval_method).
@@ -1279,12 +1404,11 @@
:- pred proc_info_set_eval_method(proc_info, eval_method, proc_info).
:- mode proc_info_set_eval_method(in, in, out) is det.
-:- pred proc_info_typeclass_info_varmap(proc_info,
- map(class_constraint, prog_var)).
+:- pred proc_info_typeclass_info_varmap(proc_info, typeclass_info_varmap).
:- mode proc_info_typeclass_info_varmap(in, out) is det.
-:- pred proc_info_set_typeclass_info_varmap(proc_info,
- map(class_constraint, prog_var), proc_info).
+:- pred proc_info_set_typeclass_info_varmap(proc_info, typeclass_info_varmap,
+ proc_info).
:- mode proc_info_set_typeclass_info_varmap(in, in, out) is det.
:- pred proc_info_maybe_declared_argmodes(proc_info, maybe(list(mode))).
@@ -1355,10 +1479,9 @@
% should be passed.
liveness_info, % the initial liveness,
% for code generation
- map(tvar, type_info_locn),
- % typeinfo vars for
- % type parameters
- map(class_constraint, prog_var),
+ type_info_varmap,
+ % typeinfo vars for type parameters
+ typeclass_info_varmap,
% typeclass_info vars for class
% constraints
eval_method, % how should the proc be evaluated
@@ -1430,11 +1553,12 @@
Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no,
IsAddressTaken).
-proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
+proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
+ TI_VarMap, TCI_VarMap, ProcInfo) :-
ProcInfo0 = procedure(A, _, _, _, E, F, _,
- H, I, J, K, L, M, N, O, P, Q, R, S, T),
+ H, I, J, K, L, M, _, _, P, Q, R, S, T),
ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
- H, I, J, K, L, M, N, O, P, Q, R, S, T).
+ H, I, J, K, L, M, TI_VarMap, TCI_VarMap, P, Q, R, S, T).
proc_info_interface_determinism(ProcInfo, Determinism) :-
proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -1602,10 +1726,9 @@
% % should be passed.
% M liveness_info, % the initial liveness,
% % for code generation
-% N map(tvar, type_info_locn),
-% % typeinfo vars for
-% % type parameters
-% O map(class_constraint, var),
+% N type_info_varmap,
+% % typeinfo vars for type parameters
+% O typeclass_info_varmap,
% % typeclass_info vars for class
% % constraints
% P eval_method,
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.64
diff -u -r1.64 intermod.m
--- intermod.m 1999/04/23 01:02:44 1.64
+++ intermod.m 1999/06/09 11:40:15
@@ -217,14 +217,14 @@
->
{ pred_info_clauses_info(PredInfo0, ClausesInfo0) },
{ pred_info_typevarset(PredInfo0, TVarSet) },
- { ClausesInfo0 = clauses_info(VarSet, DeclTypes, VarTypes,
- HeadVars, Clauses0) },
+ { clauses_info_vartypes(ClausesInfo0, VarTypes) },
+ { clauses_info_clauses(ClausesInfo0, Clauses0) },
intermod_info_set_var_types(VarTypes),
intermod_info_set_tvarset(TVarSet),
intermod__traverse_clauses(Clauses0, Clauses, DoWrite),
( { DoWrite = yes } ->
- { ClausesInfo = clauses_info(VarSet, DeclTypes,
- VarTypes, HeadVars, Clauses) },
+ { clauses_info_set_clauses(ClausesInfo0, Clauses,
+ ClausesInfo) },
{ pred_info_set_clauses_info(PredInfo0, ClausesInfo,
PredInfo) },
{ map__det_update(PredTable0, PredId,
@@ -1064,15 +1064,18 @@
% already be in the interface file.
{ pred_info_clauses_info(PredInfo, ClausesInfo) },
- { ClausesInfo = clauses_info(Varset, _, _VarTypes, HeadVars, Clauses) },
+ { clauses_info_varset(ClausesInfo, VarSet) },
+ { clauses_info_headvars(ClausesInfo, HeadVars) },
+ { clauses_info_clauses(ClausesInfo, Clauses) },
+
% handle pragma c_code(...) separately
( { pred_info_get_goal_type(PredInfo, pragmas) } ->
{ pred_info_procedures(PredInfo, Procs) },
- intermod__write_c_code(SymName, PredOrFunc, HeadVars, Varset,
+ intermod__write_c_code(SymName, PredOrFunc, HeadVars, VarSet,
Clauses, Procs)
;
% { pred_info_typevarset(PredInfo, TVarSet) },
- hlds_out__write_clauses(1, ModuleInfo, PredId, Varset, no,
+ hlds_out__write_clauses(1, ModuleInfo, PredId, VarSet, no,
HeadVars, PredOrFunc, Clauses, no)
% HeadVars, Clauses, yes(TVarSet, VarTypes))
),
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.49
diff -u -r1.49 lambda.m
--- lambda.m 1999/06/01 09:43:53 1.49
+++ lambda.m 1999/06/08 05:50:06
@@ -72,6 +72,9 @@
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, prog_data.
:- import_module list, map, set.
+:- pred lambda__process_module(module_info, module_info).
+:- mode lambda__process_module(in, out) is det.
+
:- pred lambda__process_pred(pred_id, module_info, module_info).
:- mode lambda__process_pred(in, in, out) is det.
@@ -89,7 +92,7 @@
:- implementation.
-:- import_module make_hlds, globals, options, term, varset.
+:- import_module make_hlds, globals, options, term, varset, type_util.
:- import_module goal_util, prog_util, mode_util, inst_match, llds, arg_info.
:- import_module bool, string, std_util, require.
@@ -117,6 +120,20 @@
% This whole section just traverses the module structure.
+lambda__process_module(ModuleInfo0, ModuleInfo) :-
+ module_info_predids(ModuleInfo0, PredIds),
+ lambda__process_preds(PredIds, ModuleInfo0, ModuleInfo1),
+ % Need update the dependency graph to include the lambda predicates.
+ module_info_clobber_dependency_info(ModuleInfo1, ModuleInfo).
+
+:- pred lambda__process_preds(list(pred_id), module_info, module_info).
+:- mode lambda__process_preds(in, in, out) is det.
+
+lambda__process_preds([], ModuleInfo, ModuleInfo).
+lambda__process_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) :-
+ lambda__process_pred(PredId, ModuleInfo0, ModuleInfo1),
+ lambda__process_preds(PredIds, ModuleInfo1, ModuleInfo).
+
lambda__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
pred_info_procids(PredInfo, ProcIds),
@@ -200,10 +217,13 @@
Unify - GoalInfo) -->
( { Y = lambda_goal(PredOrFunc, NonLocalVars, Vars,
Modes, Det, LambdaGoal0) } ->
- % for lambda expressions, we must convert the lambda expression
- % into a new predicate
+ % first, process the lambda goal recursively, in case it
+ % contains some nested lambda expressions.
+ lambda__process_goal(LambdaGoal0, LambdaGoal1),
+
+ % then, convert the lambda expression into a new predicate
lambda__process_lambda(PredOrFunc, Vars, Modes, Det,
- NonLocalVars, LambdaGoal0,
+ NonLocalVars, LambdaGoal1,
Unification, Y1, Unification1),
{ Unify = unify(XVar, Y1, Mode, Unification1, Context) }
;
@@ -274,9 +294,22 @@
lambda__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals0, LambdaGoal,
Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
- LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
+ LambdaInfo0 = lambda_info(VarSet, VarTypes, _PredConstraints, TVarSet,
TVarMap, TCVarMap, Markers, POF, PredName, Owner, ModuleInfo0),
- % XXX existentially typed lambda expressions are not yet supported
+
+ % Calculate the constraints which apply to this lambda
+ % expression.
+ % Note currently we only allow lambda expressions
+ % to have universally quantified constraints.
+ map__keys(TCVarMap, AllConstraints),
+ map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
+ list__map(type_util__vars, LambdaVarTypes, LambdaTypeVarsList),
+ list__condense(LambdaTypeVarsList, LambdaTypeVars),
+ list__filter(lambda__constraint_contains_vars(LambdaTypeVars),
+ AllConstraints, UnivConstraints),
+ Constraints = constraints(UnivConstraints, []),
+
+ % existentially typed lambda expressions are not yet supported
% (see the documentation at top of this file)
ExistQVars = [],
LambdaGoal = _ - LambdaGoalInfo,
@@ -290,6 +323,19 @@
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, Markers, POF, PredName, Owner, ModuleInfo).
+:- pred lambda__constraint_contains_vars(list(tvar), class_constraint).
+:- mode lambda__constraint_contains_vars(in, in) is semidet.
+
+lambda__constraint_contains_vars(LambdaVars, ClassConstraint) :-
+ ClassConstraint = constraint(_, ConstraintTypes),
+ list__map(type_util__vars, ConstraintTypes, ConstraintVarsList),
+ list__condense(ConstraintVarsList, ConstraintVars),
+ % Probably not the most efficient way of doing it, but I
+ % wouldn't think that it matters.
+ set__list_to_set(LambdaVars, LambdaVarsSet),
+ set__list_to_set(ConstraintVars, ConstraintVarsSet),
+ set__subset(ConstraintVarsSet, LambdaVarsSet).
+
lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
OrigVars, ExtraTypeInfos, LambdaGoal, Unification0,
VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
@@ -301,7 +347,7 @@
Var = Var0,
UniModes1 = UniModes0
;
- error("polymorphism__transform_lambda: weird unification")
+ error("lambda__transform_lambda: weird unification")
),
% Optimize a special case: replace
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.81
diff -u -r1.81 live_vars.m
--- live_vars.m 1999/06/01 09:43:55 1.81
+++ live_vars.m 1999/06/08 00:42:37
@@ -359,7 +359,7 @@
build_live_sets_in_goal_2(unify(_,_,_,D,_), Liveness, ResumeVars0, LiveSets0,
_, _, _, Liveness, ResumeVars0, LiveSets) :-
(
- D = complicated_unify(_, _)
+ D = complicated_unify(_, _, _)
->
% we have to save all live and protected variables
% across complicated unifications.
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.4
diff -u -r1.4 magic.m
--- magic.m 1999/06/01 09:43:57 1.4
+++ magic.m 1999/06/09 07:32:18
@@ -1216,7 +1216,7 @@
magic__make_type_info_vars(Types, TypeInfoVars, TypeInfoGoals,
PredInfo0, PredInfo, ProcInfo0, ProcInfo) -->
magic_info_get_module_info(ModuleInfo0),
- { init_poly_info(ModuleInfo0, PredInfo0, ProcInfo0, PolyInfo0) },
+ { create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0, PolyInfo0) },
{ ExistQVars = [] },
{ term__context_init(Context) },
{ polymorphism__make_type_info_vars(Types, ExistQVars, Context,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.295
diff -u -r1.295 make_hlds.m
--- make_hlds.m 1999/06/01 09:43:58 1.295
+++ make_hlds.m 1999/06/09 11:02:07
@@ -856,8 +856,10 @@
Goal = call(PredId, DummyProcId, Args,
not_builtin, no, SymName) - GoalInfo,
Clause = clause(ProcIds, Goal, Context),
+ map__init(TI_VarMap),
+ map__init(TCI_VarMap),
Clauses = clauses_info(ArgVarSet, VarTypes0,
- VarTypes0, Args, [Clause]),
+ VarTypes0, Args, [Clause], TI_VarMap, TCI_VarMap),
pred_info_get_markers(PredInfo0, Markers),
map__init(Proofs),
( pred_info_is_imported(PredInfo0) ->
@@ -2357,8 +2359,8 @@
pred_info_name(PredInfo0, Name),
pred_info_context(PredInfo0, Context),
pred_info_clauses_info(PredInfo0, ClausesInfo0),
- ClausesInfo0 = clauses_info(VarSet, _VarTypes0, _VarTypes1,
- HeadVars, _ClauseList0),
+ clauses_info_varset(ClausesInfo0, VarSet),
+ clauses_info_headvars(ClausesInfo0, HeadVars),
%
% construct the pseudo-recursive call to Module:Name(HeadVars)
@@ -2385,8 +2387,10 @@
%
ClauseList = [Clause],
map__from_corresponding_lists(HeadVars, Types, VarTypes),
+ map__init(TI_VarMap),
+ map__init(TCI_VarMap),
ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes,
- HeadVars, ClauseList),
+ HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
%-----------------------------------------------------------------------------%
@@ -4177,7 +4181,10 @@
map__init(VarTypes),
varset__init(VarSet0),
make_n_fresh_vars("HeadVar__", Arity, VarSet0, HeadVars, VarSet),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, []).
+ map__init(TI_VarMap),
+ map__init(TCI_VarMap),
+ ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, [],
+ TI_VarMap, TCI_VarMap).
:- pred clauses_info_add_clause(clauses_info::in, pred_id::in,
list(proc_id)::in, prog_varset::in, tvarset::in,
@@ -4190,7 +4197,8 @@
Args, Body, Context, Goal, VarSet, TVarSet0,
ClausesInfo, Warnings, Info0, Info) -->
{ ClausesInfo0 = clauses_info(VarSet0, VarTypes0, VarTypes1,
- HeadVars, ClauseList0) },
+ HeadVars, ClauseList0,
+ TI_VarMap, TCI_VarMap) },
{ update_qual_info(Info0, TVarSet0, VarTypes0, PredId, Info1) },
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context,
@@ -4200,7 +4208,8 @@
ClauseList) },
{ qual_info_get_var_types(Info, VarTypes) },
{ ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1,
- HeadVars, ClauseList) }.
+ HeadVars, ClauseList,
+ TI_VarMap, TCI_VarMap) }.
%-----------------------------------------------------------------------------
@@ -4221,7 +4230,7 @@
ClausesInfo, Info0, Info) -->
{
ClausesInfo0 = clauses_info(VarSet0, VarTypes, VarTypes1,
- HeadVars, ClauseList),
+ HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
pragma_get_vars(PVars, Args0),
pragma_get_var_infos(PVars, ArgInfo),
@@ -4250,7 +4259,7 @@
HldsGoal, VarSet, _, _Warnings),
NewClause = clause([ModeId], HldsGoal, Context),
ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1, HeadVars,
- [NewClause|ClauseList])
+ [NewClause|ClauseList], TI_VarMap, TCI_VarMap)
}.
:- pred allocate_vars_for_saved_vars(list(string), list(pair(prog_var, string)),
@@ -5023,7 +5032,7 @@
Goal) :-
UMode = ((free - free) -> (free - free)),
Mode = ((free -> free) - (free -> free)),
- UnifyInfo = complicated_unify(UMode, can_fail),
+ UnifyInfo = complicated_unify(UMode, can_fail, []),
UnifyC = unify_context(UnifyMainContext, UnifySubContext),
goal_info_init(GoalInfo0),
goal_info_set_context(GoalInfo0, Context, GoalInfo),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.128
diff -u -r1.128 mercury_compile.m
--- mercury_compile.m 1999/06/01 09:44:04 1.128
+++ mercury_compile.m 1999/06/08 00:42:39
@@ -30,12 +30,12 @@
% the main compiler passes (mostly in order of execution)
:- import_module handle_options, prog_io, prog_out, modules, module_qual.
-:- import_module equiv_type, make_hlds, typecheck, purity, modes.
+:- import_module equiv_type, make_hlds, typecheck, purity, polymorphism, modes.
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
:- import_module stratify, check_typeclass, simplify, intermod, trans_opt.
:- import_module table_gen.
:- import_module bytecode_gen, bytecode.
-:- import_module (lambda), polymorphism, termination, higher_order, inlining.
+:- import_module (lambda), termination, higher_order, inlining.
:- import_module deforest, dnf, unused_args, magic, dead_proc_elim.
:- import_module lco, saved_vars, liveness.
:- import_module follow_code, live_vars, arg_info, store_alloc, goal_path.
@@ -388,12 +388,8 @@
% the appropriate warnings
globals__io_lookup_bool_option(warn_unused_args, UnusedArgs),
( { UnusedArgs = yes } ->
- % Run polymorphism so that the unused argument numbers
- % read in from `.opt' files are correct.
- mercury_compile__maybe_polymorphism(HLDS21,
- Verbose, Stats, HLDS22),
globals__io_set_option(optimize_unused_args, bool(no)),
- mercury_compile__maybe_unused_args(HLDS22,
+ mercury_compile__maybe_unused_args(HLDS21,
Verbose, Stats, _)
;
[]
@@ -764,27 +760,25 @@
( { MakeOptInt = yes } ->
intermod__write_optfile(HLDS0, HLDS1),
- % If intermod_unused_args is being performed, run mode and
- % determinism analysis and polymorphism, then run unused_args
+ % If intermod_unused_args is being performed, run polymorphism,
+ % mode analysis and determinism analysis, then run unused_args
% to append the unused argument information to the `.opt.tmp'
% file written above.
( { IntermodArgs = yes ; Termination = yes } ->
mercury_compile__frontend_pass_2_by_phases(
HLDS1, HLDS2, FoundModeError),
( { FoundModeError = no } ->
- mercury_compile__maybe_polymorphism(HLDS2,
- Verbose, Stats, HLDS3),
( { IntermodArgs = yes } ->
mercury_compile__maybe_unused_args(
- HLDS3, Verbose, Stats, HLDS4)
+ HLDS2, Verbose, Stats, HLDS3)
;
- { HLDS4 = HLDS3 }
+ { HLDS3 = HLDS2 }
),
( { Termination = yes } ->
mercury_compile__maybe_termination(
- HLDS4, Verbose, Stats, HLDS)
+ HLDS3, Verbose, Stats, HLDS)
;
- { HLDS = HLDS4 }
+ { HLDS = HLDS3 }
)
;
@@ -835,10 +829,7 @@
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
- mercury_compile__maybe_polymorphism(HLDS25, Verbose, Stats, HLDS26),
- mercury_compile__maybe_dump_hlds(HLDS26, "26", "polymorphism"), !,
-
- mercury_compile__maybe_termination(HLDS26, Verbose, Stats, HLDS28),
+ mercury_compile__maybe_termination(HLDS25, Verbose, Stats, HLDS28),
mercury_compile__maybe_dump_hlds(HLDS28, "28", "termination"), !,
trans_opt__write_optfile(HLDS28).
@@ -870,33 +861,36 @@
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
- mercury_compile__modecheck(HLDS4, Verbose, Stats, HLDS5,
+ mercury_compile__maybe_polymorphism(HLDS4, Verbose, Stats, HLDS5), !,
+ mercury_compile__maybe_dump_hlds(HLDS5, "05", "polymorphism"),
+
+ mercury_compile__modecheck(HLDS5, Verbose, Stats, HLDS6,
FoundModeError, UnsafeToContinue),
- mercury_compile__maybe_dump_hlds(HLDS5, "05", "modecheck"),
+ mercury_compile__maybe_dump_hlds(HLDS6, "06", "modecheck"),
( { UnsafeToContinue = yes } ->
{ FoundError = yes },
- { HLDS12 = HLDS5 }
+ { HLDS12 = HLDS6 }
;
- mercury_compile__detect_switches(HLDS5, Verbose, Stats, HLDS6),
+ mercury_compile__detect_switches(HLDS6, Verbose, Stats, HLDS7),
!,
- mercury_compile__maybe_dump_hlds(HLDS6, "06", "switch_detect"),
+ mercury_compile__maybe_dump_hlds(HLDS7, "07", "switch_detect"),
!,
- mercury_compile__detect_cse(HLDS6, Verbose, Stats, HLDS7), !,
- mercury_compile__maybe_dump_hlds(HLDS7, "07", "cse"), !,
+ mercury_compile__detect_cse(HLDS7, Verbose, Stats, HLDS8), !,
+ mercury_compile__maybe_dump_hlds(HLDS8, "08", "cse"), !,
- mercury_compile__check_determinism(HLDS7, Verbose, Stats, HLDS8,
+ mercury_compile__check_determinism(HLDS8, Verbose, Stats, HLDS9,
FoundDetError), !,
- mercury_compile__maybe_dump_hlds(HLDS8, "08", "determinism"),
+ mercury_compile__maybe_dump_hlds(HLDS9, "09", "determinism"),
!,
- mercury_compile__check_unique_modes(HLDS8, Verbose, Stats,
- HLDS9, FoundUniqError), !,
- mercury_compile__maybe_dump_hlds(HLDS9, "09", "unique_modes"),
+ mercury_compile__check_unique_modes(HLDS9, Verbose, Stats,
+ HLDS10, FoundUniqError), !,
+ mercury_compile__maybe_dump_hlds(HLDS10, "10", "unique_modes"),
!,
- mercury_compile__check_stratification(HLDS9, Verbose, Stats,
+ mercury_compile__check_stratification(HLDS10, Verbose, Stats,
HLDS11, FoundStratError), !,
mercury_compile__maybe_dump_hlds(HLDS11, "11",
"stratification"), !,
@@ -953,16 +947,16 @@
mercury_compile__tabling(HLDS24, Verbose, HLDS25),
mercury_compile__maybe_dump_hlds(HLDS25, "25", "tabling"), !,
- mercury_compile__maybe_polymorphism(HLDS25, Verbose, Stats, HLDS26),
- mercury_compile__maybe_dump_hlds(HLDS26, "26", "polymorphism"), !,
+ mercury_compile__process_lambdas(HLDS25, Verbose, HLDS26),
+ mercury_compile__maybe_dump_hlds(HLDS26, "26", "lambda"), !,
%
% Uncomment the following code to check that unique mode analysis
- % works after polymorphism has been run. Currently it does not
+ % works after simplification has been run. Currently it does not
% because common.m does not preserve unique mode correctness
% (this test fails on about five modules in the compiler and library).
% It is important that unique mode analysis work most of the time
- % after optimizations and polymorphism because deforestation reruns it.
+ % after optimizations because deforestation reruns it.
%
{ HLDS27 = HLDS26 },
@@ -1525,8 +1519,8 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_compile__tabling(module_info, bool,
- module_info, io__state, io__state).
+:- pred mercury_compile__tabling(module_info, bool, module_info,
+ io__state, io__state).
:- mode mercury_compile__tabling(in, in, out, di, uo) is det.
mercury_compile__tabling(HLDS0, Verbose, HLDS) -->
@@ -1538,6 +1532,19 @@
%-----------------------------------------------------------------------------%
+:- pred mercury_compile__process_lambdas(module_info, bool, module_info,
+ io__state, io__state).
+:- mode mercury_compile__process_lambdas(in, in, out, di, uo) is det.
+
+mercury_compile__process_lambdas(HLDS0, Verbose, HLDS) -->
+ maybe_write_string(Verbose,
+ "% Transforming lambda expressions..."),
+ maybe_flush_output(Verbose),
+ { lambda__process_module(HLDS0, HLDS) },
+ maybe_write_string(Verbose, " done.\n").
+
+%-----------------------------------------------------------------------------%
+
:- pred mercury_compile__maybe_polymorphism(module_info, bool, bool,
module_info, io__state, io__state).
:- mode mercury_compile__maybe_polymorphism(in, in, in, out, di, uo) is det.
@@ -1552,7 +1559,11 @@
maybe_write_string(Verbose, " done.\n"),
maybe_report_stats(Stats)
;
- { HLDS = HLDS0 }
+ % The --no-polymorphism option really doesn't make much
+ % sense anymore, because the polymorphism pass is necessary
+ % for the proper mode analysis of code using existential
+ % types.
+ { error("sorry, `--no-polymorphism' is no longer supported") }
).
:- pred mercury_compile__maybe_type_ctor_infos(module_info, bool, bool,
Index: compiler/mercury_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_c.m,v
retrieving revision 1.38
diff -u -r1.38 mercury_to_c.m
--- mercury_to_c.m 1998/11/20 04:08:18 1.38
+++ mercury_to_c.m 1999/06/09 11:05:18
@@ -177,8 +177,9 @@
ClassContext, Context),
{ pred_info_clauses_info(PredInfo, ClausesInfo) },
- { ClausesInfo = clauses_info(VarSet, _VarTypes, _, HeadVars,
- Clauses) },
+ { clauses_info_varset(ClausesInfo, VarSet) },
+ { clauses_info_headvars(ClausesInfo, HeadVars) },
+ { clauses_info_clauses(ClausesInfo, Clauses) },
globals__io_lookup_string_option(dump_hlds_options, Verbose),
globals__io_set_option(dump_hlds_options, string("")),
@@ -727,7 +728,7 @@
c_gen_unification(deconstruct(_, _, _, _, _), _Indent, CGenInfo, CGenInfo) -->
{ sorry(2) },
io__write_string(" == ").
-c_gen_unification(complicated_unify(_, _), _Indent, CGenInfo, CGenInfo) -->
+c_gen_unification(complicated_unify(_, _, _), _Indent, CGenInfo, CGenInfo) -->
{ sorry(3) },
io__write_string(" = ").
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.37
diff -u -r1.37 modecheck_unify.m
--- modecheck_unify.m 1999/05/18 03:08:57 1.37
+++ modecheck_unify.m 1999/06/10 14:23:19
@@ -20,8 +20,7 @@
:- module modecheck_unify.
:- interface.
-:- import_module hlds_goal, hlds_data, prog_data, mode_info.
-:- import_module map.
+:- import_module hlds_goal, prog_data, mode_info.
% Modecheck a unification
:- pred modecheck_unification(prog_var, unify_rhs, unification, unify_context,
@@ -29,18 +28,11 @@
:- mode modecheck_unification(in, in, in, in, in, out,
mode_info_di, mode_info_uo) is det.
- % Work out what kind of unification a var-var unification is.
-:- pred categorize_unify_var_var(mode, mode, is_live, is_live, prog_var,
- prog_var, determinism, unify_context, map(prog_var, type),
- mode_info, hlds_goal_expr, mode_info).
-:- mode categorize_unify_var_var(in, in, in, in, in, in, in, in, in,
- mode_info_di, out, mode_info_uo) is det.
-
% Create a unification between the two given variables.
% The goal's mode and determinism information is not filled in.
-:- pred modecheck_unify__create_var_var_unification(prog_var, prog_var,
+:- pred modecheck_unify__create_var_var_unification(prog_var, prog_var, type,
mode_info, hlds_goal).
-:- mode modecheck_unify__create_var_var_unification(in, in,
+:- mode modecheck_unify__create_var_var_unification(in, in, in,
mode_info_ui, out) is det.
%-----------------------------------------------------------------------------%
@@ -49,18 +41,19 @@
:- implementation.
:- import_module llds, prog_util, type_util, module_qual, instmap.
-:- import_module hlds_module, hlds_goal, hlds_pred, hlds_out.
+:- import_module hlds_module, hlds_goal, hlds_pred, hlds_data, hlds_out.
:- import_module mode_debug, mode_util, mode_info, modes, mode_errors.
:- import_module inst_match, inst_util, unify_proc, code_util, unique_modes.
:- import_module typecheck, modecheck_call, (inst), quantification, make_hlds.
+:- import_module polymorphism.
-:- import_module bool, list, std_util, int, set, require.
+:- import_module bool, list, map, std_util, int, set, require.
:- import_module string, assoc_list.
:- import_module term, varset.
%-----------------------------------------------------------------------------%
-modecheck_unification(X, var(Y), _Unification0, UnifyContext, _GoalInfo,
+modecheck_unification(X, var(Y), Unification0, UnifyContext, _GoalInfo,
Unify, ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_instmap(ModeInfo0, InstMap0),
@@ -86,7 +79,8 @@
ModeOfY = (InstOfY -> Inst),
mode_info_get_var_types(ModeInfo3, VarTypes),
categorize_unify_var_var(ModeOfX, ModeOfY, LiveX, LiveY, X, Y,
- Det, UnifyContext, VarTypes, ModeInfo3, Unify, ModeInfo)
+ Det, UnifyContext, VarTypes, Unification0, ModeInfo3,
+ Unify, ModeInfo)
;
set__list_to_set([X, Y], WaitingVars),
mode_info_error(WaitingVars, mode_error_unify_var_var(X, Y,
@@ -109,225 +103,11 @@
modecheck_unification(X0, functor(ConsId0, ArgVars0), Unification0,
UnifyContext, GoalInfo0, Goal, ModeInfo0, ModeInfo) :-
- mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_var_types(ModeInfo0, VarTypes0),
map__lookup(VarTypes0, X0, TypeOfX),
- module_info_get_predicate_table(ModuleInfo0, PredTable),
- list__length(ArgVars0, Arity),
- mode_info_get_predid(ModeInfo0, ThisPredId),
- mode_info_get_how_to_check(ModeInfo0, HowToCheckGoal),
- (
- %
- % is the function symbol apply/N or ''/N,
- % representing a higher-order function call?
- %
- % (As an optimization, if HowToCheck = check_unique_modes,
- % then don't bother checking, since they will have already
- % been expanded.)
- %
- HowToCheckGoal \= check_unique_modes,
- ConsId0 = cons(unqualified(ApplyName), _),
- ( ApplyName = "apply" ; ApplyName = "" ),
- Arity >= 1,
- ArgVars0 = [FuncVar | FuncArgVars]
- ->
- %
- % Convert the higher-order function call (apply/N)
- % into a higher-order predicate call
- % (i.e., replace `X = apply(F, A, B, C)'
- % with `call(F, A, B, C, X)')
- % and then mode-check it.
- %
- modecheck_higher_order_func_call(FuncVar, FuncArgVars, X0,
- GoalInfo0, Goal, ModeInfo0, ModeInfo)
- ;
- %
- % is the function symbol a user-defined function, rather
- % than a functor which represents a data constructor?
- %
-
- % As an optimization, if HowToCheck = check_unique_modes,
- % then don't bother checking, since they will have already
- % been expanded.
- HowToCheckGoal \= check_unique_modes,
-
- % Find the set of candidate predicates which have the
- % specified name and arity (and module, if module-qualified)
- ConsId0 = cons(PredName, _),
- module_info_pred_info(ModuleInfo0, ThisPredId, PredInfo),
-
- %
- % We don't do this for compiler-generated predicates;
- % they are assumed to have been generated with all
- % functions already expanded.
- % If we did this check for compiler-generated
- % predicates, it would cause the wrong behaviour
- % in the case where there is a user-defined function
- % whose type is exactly the same as the type of
- % a constructor. (Normally that would cause
- % a type ambiguity error, but compiler-generated
- % predicates are not type-checked.)
- %
-
- \+ code_util__compiler_generated(PredInfo),
-
- predicate_table_search_func_sym_arity(PredTable,
- PredName, Arity, PredIds),
-
- % Check if any of the candidate functions have
- % argument/return types which subsume the actual
- % argument/return types of this function call
-
- pred_info_typevarset(PredInfo, TVarSet),
- map__apply_to_list(ArgVars0, VarTypes0, ArgTypes0),
- list__append(ArgTypes0, [TypeOfX], ArgTypes),
- typecheck__find_matching_pred_id(PredIds, ModuleInfo0,
- TVarSet, ArgTypes, PredId, QualifiedFuncName)
- ->
- %
- % Convert function calls into predicate calls:
- % replace `X = f(A, B, C)'
- % with `f(A, B, C, X)'
- %
- invalid_proc_id(ProcId),
- list__append(ArgVars0, [X0], ArgVars),
- FuncCallUnifyContext = call_unify_context(X0,
- functor(ConsId0, ArgVars0), UnifyContext),
- FuncCall = call(PredId, ProcId, ArgVars, not_builtin,
- yes(FuncCallUnifyContext), QualifiedFuncName),
- %
- % now modecheck it
- %
- modecheck_goal_expr(FuncCall, GoalInfo0, Goal, ModeInfo0, ModeInfo)
-
- ;
-
- %
- % We replace any unifications with higher-order pred constants
- % by lambda expressions. For example, we replace
- %
- % X = list__append(Y) % Y::in, X::out
- %
- % with
- %
- % X = lambda [A1::in, A2::out] (list__append(Y, A1, A2))
- %
- % We do this because it makes two things easier.
- % Firstly, we need to check that the lambda-goal doesn't
- % bind any non-local variables (e.g. `Y' in above example).
- % This would require a bit of moderately tricky special-case code
- % if we didn't expand them.
- % Secondly, the polymorphism pass (polymorphism.m) is a lot easier
- % if we don't have to handle higher-order pred consts.
- % If it turns out that the predicate was non-polymorphic,
- % lambda.m will (I hope) turn the lambda expression
- % back into a higher-order pred constant again.
- %
-
- % check if variable has a higher-order type
- type_is_higher_order(TypeOfX, PredOrFunc, PredArgTypes),
- ConsId0 = cons(PName, _),
- % but in case we are redoing mode analysis, make sure
- % we don't mess with the address constants for type_info
- % fields created by polymorphism.m
- Unification0 \= construct(_, code_addr_const(_, _), _, _),
- Unification0 \= deconstruct(_, code_addr_const(_, _), _, _, _)
- ->
- %
- % Create the new lambda-quantified variables
- %
- mode_info_get_varset(ModeInfo0, VarSet0),
- make_fresh_vars(PredArgTypes, VarSet0, VarTypes0,
- LambdaVars, VarSet, VarTypes),
- list__append(ArgVars0, LambdaVars, Args),
- mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1),
- mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo2),
-
- %
- % Build up the hlds_goal_expr for the call that will form
- % the lambda goal
- %
-
- module_info_pred_info(ModuleInfo0, ThisPredId, ThisPredInfo),
- pred_info_typevarset(ThisPredInfo, TVarSet),
- map__apply_to_list(Args, VarTypes, ArgTypes),
- (
- % If we are redoing mode analysis, use the
- % pred_id and proc_id found before, to avoid aborting
- % in get_pred_id_and_proc_id if there are multiple
- % matching procedures.
- Unification0 = construct(_,
- pred_const(PredId0, ProcId0), _, _)
- ->
- PredId = PredId0,
- ProcId = ProcId0
- ;
- get_pred_id_and_proc_id(PName, PredOrFunc, TVarSet,
- ArgTypes, ModuleInfo0, PredId, ProcId)
- ),
- module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
- PredInfo, ProcInfo),
-
- % module-qualify the pred name (is this necessary?)
- pred_info_module(PredInfo, PredModule),
- unqualify_name(PName, UnqualPName),
- QualifiedPName = qualified(PredModule, UnqualPName),
-
- CallUnifyContext = call_unify_context(X0,
- functor(ConsId0, ArgVars0), UnifyContext),
- LambdaGoalExpr = call(PredId, ProcId, Args, not_builtin,
- yes(CallUnifyContext), QualifiedPName),
-
- %
- % construct a goal_info for the lambda goal, making sure
- % to set up the nonlocals field in the goal_info correctly
- %
- goal_info_get_nonlocals(GoalInfo0, NonLocals),
- set__insert_list(NonLocals, LambdaVars, OutsideVars),
- set__list_to_set(Args, InsideVars),
- set__intersect(OutsideVars, InsideVars, LambdaNonLocals),
- goal_info_init(LambdaGoalInfo0),
- mode_info_get_context(ModeInfo2, Context),
- goal_info_set_context(LambdaGoalInfo0, Context,
- LambdaGoalInfo1),
- goal_info_set_nonlocals(LambdaGoalInfo1, LambdaNonLocals,
- LambdaGoalInfo),
- LambdaGoal = LambdaGoalExpr - LambdaGoalInfo,
-
- %
- % work out the modes of the introduced lambda variables
- % and the determinism of the lambda goal
- %
- proc_info_argmodes(ProcInfo, ArgModes),
- ( list__drop(Arity, ArgModes, LambdaModes0) ->
- LambdaModes = LambdaModes0
- ;
- error("modecheck_unification: list__drop failed")
- ),
- proc_info_declared_determinism(ProcInfo, MaybeDet),
- ( MaybeDet = yes(Det) ->
- LambdaDet = Det
- ;
- error("Sorry, not implemented: determinism inference for higher-order predicate terms")
- ),
-
- %
- % construct the lambda expression, and then go ahead
- % and modecheck this unification in its new form
- %
- Functor0 = lambda_goal(PredOrFunc, ArgVars0, LambdaVars,
- LambdaModes, LambdaDet, LambdaGoal),
- modecheck_unification( X0, Functor0, Unification0, UnifyContext,
- GoalInfo0, Goal, ModeInfo2, ModeInfo)
- ;
- %
- % It's not a higher-order pred unification - just
- % call modecheck_unify_functor to do the ordinary thing.
- %
- modecheck_unify_functor(X0, TypeOfX,
- ConsId0, ArgVars0, Unification0, UnifyContext,
- GoalInfo0, Goal, ModeInfo0, ModeInfo)
- ).
+ modecheck_unify_functor(X0, TypeOfX,
+ ConsId0, ArgVars0, Unification0, UnifyContext,
+ GoalInfo0, Goal, ModeInfo0, ModeInfo).
modecheck_unification(X,
lambda_goal(PredOrFunc, ArgVars, Vars, Modes0, Det, Goal0),
@@ -810,7 +590,7 @@
mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo2),
modecheck_unify__create_var_var_unification(Var0, Var,
- ModeInfo2, ExtraGoal),
+ VarType, ModeInfo2, ExtraGoal),
% insert the new unification at
% the start of the extra goals
@@ -827,32 +607,68 @@
Vars = [Var0 | Vars1]
).
-modecheck_unify__create_var_var_unification(Var0, Var, ModeInfo,
- ExtraGoal - GoalInfo) :-
+modecheck_unify__create_var_var_unification(Var0, Var, Type, ModeInfo,
+ Goal - GoalInfo) :-
mode_info_get_context(ModeInfo, Context),
mode_info_get_mode_context(ModeInfo, ModeContext),
mode_context_to_unify_context(ModeContext, ModeInfo, UnifyContext),
UnifyContext = unify_context(MainContext, SubContexts),
create_atomic_unification(Var0, var(Var), Context,
- MainContext, SubContexts, ExtraGoal - GoalInfo0),
-
- % compute the goal_info nonlocal vars
- % for the newly created goal
+ MainContext, SubContexts, Goal0 - GoalInfo0),
+
+ %
+ % compute the goal_info nonlocal vars for the newly created goal
+ % (excluding the type_info vars -- they are added below).
% N.B. This may overestimate the set of non-locals,
% but that shouldn't cause any problems.
+ %
set__list_to_set([Var0, Var], NonLocals),
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
- goal_info_set_context(GoalInfo1, Context, GoalInfo).
+ goal_info_set_context(GoalInfo1, Context, GoalInfo2),
+ %
+ % Look up the map(tvar, type_info_locn) in the proc_info,
+ % since it is needed by polymorphism__unification_typeinfos
+ %
+ mode_info_get_module_info(ModeInfo, ModuleInfo),
+ mode_info_get_predid(ModeInfo, PredId),
+ mode_info_get_procid(ModeInfo, ProcId),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _PredInfo, ProcInfo),
+ proc_info_typeinfo_varmap(ProcInfo, TypeInfoVarMap),
+
+ %
+ % Call polymorphism__unification_typeinfos to add the appropriate
+ % type-info and type-class-info variables to the nonlocals
+ % and to the unification.
+ %
+ (
+ Goal0 = unify(X, Y, Mode, Unification0, FinalUnifyContext)
+ ->
+ polymorphism__unification_typeinfos(Type, TypeInfoVarMap,
+ Unification0, GoalInfo2, Unification, GoalInfo),
+ Goal = unify(X, Y, Mode, Unification, FinalUnifyContext)
+ ;
+ error("modecheck_unify__create_var_var_unification")
+ ).
+
%-----------------------------------------------------------------------------%
+ % Work out what kind of unification a var-var unification is.
+:- pred categorize_unify_var_var(mode, mode, is_live, is_live, prog_var,
+ prog_var, determinism, unify_context, map(prog_var, type),
+ unification, mode_info, hlds_goal_expr, mode_info).
+:- mode categorize_unify_var_var(in, in, in, in, in, in, in, in, in, in,
+ mode_info_di, out, mode_info_uo) is det.
+
% categorize_unify_var_var works out which category a unification
% between a variable and another variable expression is - whether it is
% an assignment, a simple test or a complicated unify.
categorize_unify_var_var(ModeOfX, ModeOfY, LiveX, LiveY, X, Y, Det,
- UnifyContext, VarTypes, ModeInfo0, Unify, ModeInfo) :-
+ UnifyContext, VarTypes, Unification0, ModeInfo0,
+ Unify, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
(
mode_is_output(ModuleInfo0, ModeOfX)
@@ -887,49 +703,10 @@
Unification = simple_test(X, Y),
ModeInfo = ModeInfo0
;
- mode_get_insts(ModuleInfo0, ModeOfX, IX, FX),
- mode_get_insts(ModuleInfo0, ModeOfY, IY, FY),
- determinism_components(Det, CanFail, _),
- UniMode = ((IX - IY) -> (FX - FY)),
- Unification = complicated_unify(UniMode, CanFail),
- mode_info_get_instmap(ModeInfo0, InstMap0),
- (
- type_is_higher_order(Type, PredOrFunc, _)
- ->
- % We do not want to report this as an error
- % if it occurs in a compiler-generated
- % predicate - instead, we delay the error
- % until runtime so that it only occurs if
- % the compiler-generated predicate gets called.
- % not_reached is considered bound, so the
- % error message would be spurious if the
- % instmap is unreachable.
- mode_info_get_predid(ModeInfo0, PredId),
- module_info_pred_info(ModuleInfo0, PredId,
- PredInfo),
- (
- ( code_util__compiler_generated(PredInfo)
- ; instmap__is_unreachable(InstMap0)
- )
- ->
- ModeInfo = ModeInfo0
- ;
- set__init(WaitingVars),
- mode_info_error(WaitingVars,
- mode_error_unify_pred(X, error_at_var(Y), Type, PredOrFunc),
- ModeInfo0, ModeInfo)
- )
- ;
- type_to_type_id(Type, TypeId, _)
- ->
- mode_info_get_context(ModeInfo0, Context),
- unify_proc__request_unify(TypeId - UniMode,
- Det, Context, ModuleInfo0, ModuleInfo),
- mode_info_set_module_info(ModeInfo0, ModuleInfo,
- ModeInfo)
- ;
- ModeInfo = ModeInfo0
- )
+ modecheck_complicated_unify(X, Y,
+ Type, ModeOfX, ModeOfY, Det, UnifyContext,
+ Unification0, ModeInfo0,
+ Unification, ModeInfo)
)
),
%
@@ -969,6 +746,106 @@
UnifyContext)
).
+%
+% modecheck_complicated_unify does some extra checks that are needed
+% for mode-checking complicated unifications.
+%
+
+:- pred modecheck_complicated_unify(prog_var, prog_var,
+ type, mode, mode, determinism, unify_context,
+ unification, mode_info, unification, mode_info).
+:- mode modecheck_complicated_unify(in, in, in, in, in, in, in,
+ in, mode_info_di, out, mode_info_uo) is det.
+
+modecheck_complicated_unify(X, Y, Type, ModeOfX, ModeOfY, Det, UnifyContext,
+ Unification0, ModeInfo0, Unification, ModeInfo) :-
+ %
+ % Build up the unification
+ %
+ mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ mode_get_insts(ModuleInfo0, ModeOfX, IX, FX),
+ mode_get_insts(ModuleInfo0, ModeOfY, IY, FY),
+ UniMode = ((IX - IY) -> (FX - FY)),
+ determinism_components(Det, CanFail, _),
+ ( Unification0 = complicated_unify(_, _, UnifyTypeInfoVars0) ->
+ UnifyTypeInfoVars = UnifyTypeInfoVars0
+ ;
+ error("categorize_unify_var_var")
+ ),
+ Unification = complicated_unify(UniMode, CanFail, UnifyTypeInfoVars),
+
+ %
+ % check that all the type_info or type_class_info variables used
+ % by the polymorphic unification are ground.
+ %
+ ( UnifyTypeInfoVars = [] ->
+ % optimize common case
+ ModeInfo2 = ModeInfo0
+ ;
+ list__length(UnifyTypeInfoVars, NumTypeInfoVars),
+ list__duplicate(NumTypeInfoVars, ground(shared, no),
+ ExpectedInsts),
+ mode_info_set_call_context(unify(UnifyContext),
+ ModeInfo0, ModeInfo1),
+ InitialArgNum = 0,
+ modecheck_var_has_inst_list(UnifyTypeInfoVars, ExpectedInsts,
+ InitialArgNum, ModeInfo1, ModeInfo2)
+ ),
+
+ %
+ % check that we're not trying to do a higher-order unification
+ %
+ (
+ mode_info_get_errors(ModeInfo2, Errors),
+ Errors \= []
+ ->
+ ModeInfo = ModeInfo2
+ ;
+ type_is_higher_order(Type, PredOrFunc, _)
+ ->
+ % We do not want to report this as an error
+ % if it occurs in a compiler-generated
+ % predicate - instead, we delay the error
+ % until runtime so that it only occurs if
+ % the compiler-generated predicate gets called.
+ % not_reached is considered bound, so the
+ % error message would be spurious if the
+ % instmap is unreachable.
+ mode_info_get_predid(ModeInfo2, PredId),
+ module_info_pred_info(ModuleInfo0, PredId,
+ PredInfo),
+ mode_info_get_instmap(ModeInfo2, InstMap0),
+ (
+ ( code_util__compiler_generated(PredInfo)
+ ; instmap__is_unreachable(InstMap0)
+ )
+ ->
+ ModeInfo = ModeInfo2
+ ;
+ set__init(WaitingVars),
+ mode_info_error(WaitingVars,
+ mode_error_unify_pred(X, error_at_var(Y),
+ Type, PredOrFunc),
+ ModeInfo2, ModeInfo)
+ )
+ ;
+ %
+ % Ensure that we will generate code for the unification
+ % procedure that will be used to implement this complicated
+ % unification.
+ %
+ type_to_type_id(Type, TypeId, _)
+ ->
+ mode_info_get_context(ModeInfo2, Context),
+ unify_proc__request_unify(TypeId - UniMode,
+ Det, Context, ModuleInfo0, ModuleInfo),
+ mode_info_set_module_info(ModeInfo2, ModuleInfo,
+ ModeInfo)
+ ;
+ ModeInfo = ModeInfo2
+ ).
+
+
% categorize_unify_var_lambda works out which category a unification
% between a variable and a lambda expression is - whether it is a construction
% unification or a deconstruction. It also works out whether it will
@@ -990,7 +867,7 @@
; Unification0 = deconstruct(_, ConsId1, _, _, _) ->
ConsId = ConsId1
;
- % the real cons_id will be computed by polymorphism.m;
+ % the real cons_id will be computed by lambda.m;
% we just put in a dummy one for now
ConsId = cons(unqualified("__LambdaGoal__"), Arity)
),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.230
diff -u -r1.230 modes.m
--- modes.m 1999/05/18 03:08:59 1.230
+++ modes.m 1999/06/09 10:42:23
@@ -392,6 +392,7 @@
;
[]
),
+
%
% Mode analysis may have modified the procedure
% bodies, since it does some optimizations such
@@ -402,6 +403,7 @@
% they may therefore produce incorrect results.
% Thus we need to restore the old procedure bodies.
%
+
( { WhatToCheck = check_modes } ->
% restore the proc_info goals from the
% clauses in the pred_info
@@ -413,6 +415,7 @@
{ copy_pred_bodies(OldPredTable, PredIds,
ModuleInfo3, ModuleInfo4) }
),
+
{ MaxIterations1 is MaxIterations - 1 },
modecheck_to_fixpoint(PredIds, MaxIterations1,
WhatToCheck, MayChangeCalledProc,
@@ -487,11 +490,22 @@
NumErrors0, NumErrors) -->
{ module_info_preds(ModuleInfo0, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
- ( { pred_info_is_imported(PredInfo0) } ->
- { ModuleInfo3 = ModuleInfo0 },
- { Changed1 = Changed0 },
- { NumErrors1 = NumErrors0 }
- ; { pred_info_is_pseudo_imported(PredInfo0) } ->
+ (
+ (
+ %
+ % don't modecheck imported predicates
+ %
+ ( { pred_info_is_imported(PredInfo0) }
+ ; { pred_info_is_pseudo_imported(PredInfo0) }
+ )
+ ;
+ %
+ % don't modecheck class methods
+ %
+ { pred_info_get_markers(PredInfo0, PredMarkers) },
+ { check_marker(PredMarkers, class_method) }
+ )
+ ->
{ ModuleInfo3 = ModuleInfo0 },
{ Changed1 = Changed0 },
{ NumErrors1 = NumErrors0 }
@@ -717,7 +731,7 @@
% we use the context of the mode declaration.
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
- ClausesInfo = clauses_info(_, _, _, _, ClauseList),
+ clauses_info_clauses(ClausesInfo, ClauseList),
( ClauseList = [FirstClause | _] ->
FirstClause = clause(_, _, Context)
;
@@ -1428,7 +1442,7 @@
{ mode_info_get_predid(ModeInfo0, PredId) },
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_clauses_info(PredInfo, ClausesInfo) },
- { ClausesInfo = clauses_info(_,_,_,HeadVars,_) },
+ { clauses_info_headvars(ClausesInfo, HeadVars) },
( { no_non_headvar_unification_goals(DelayedGoals, HeadVars) } ->
{ ImpurityErrors = ImpurityErrors0 }
;
@@ -1915,7 +1929,7 @@
% Construct the code to do the unification
modecheck_unify__create_var_var_unification(Var0, Var,
- ModeInfo, ExtraGoal),
+ VarType, ModeInfo, ExtraGoal),
% append the goals together in the appropriate order:
% ExtraGoals0, then NewUnify
Index: compiler/pd_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_cost.m,v
retrieving revision 1.4
diff -u -r1.4 pd_cost.m
--- pd_cost.m 1998/11/20 04:08:41 1.4
+++ pd_cost.m 1999/06/03 17:41:38
@@ -115,7 +115,7 @@
pd_cost__unify(_, assign(_, _), 0).
-pd_cost__unify(_, complicated_unify(_, _), Cost) :-
+pd_cost__unify(_, complicated_unify(_, _, _), Cost) :-
pd_cost__stack_flush(Cost).
pd_cost__unify(_, simple_test(_, _), Cost) :-
[continued in part 2]
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list