bug fixes for module qualified cons_ids
Simon TAYLOR
stayl at students.cs.mu.oz.au
Wed Mar 19 20:49:16 AEDT 1997
Hi Fergus,
Could you please review these changes.
Thanks,
Simon
Estimated hours: 6
Bug fixes for module qualified cons_ids.
Improve the compilation time of modules with lots of user_defined insts.
(Compiling tree234.m is still way too slow. The main problem is that repeated
calls to inst_matches_initial expand the insts multiple times. With type
information in the insts to propagate, it is expensive to repeat the
expansion over and over again.)
compiler/mode_util.m
In propagate_type_info_into_modes and the predicates it calls, avoid
finding the constructors for a type and substituting the argument
types.
compiler/hlds_pred.m
Add a new field to the proc_info, maybe_declared_argmodes which
holds the declared arg_modes for use in .opt files and error messages.
compiler/typecheck.m
Call propagate_type_info_into_modes from here to avoid calling it
many times throughout mode analysis. This does not cause a
substantial performance improvement, but reduces confusion
over where everything should be module qualified.
This also fixes a bug with the no_tag optimisation reported by
Mark Brown. A runtime abort occurred because a constructor in a bound
inst was not being module qualified which confused mode_to_arg_mode
into giving the argument an arg_mode of top_unused.
compiler/lambda.m
compiler/modecheck_unify.m
Call propagate_type_info_mode_list for modes of lambda predicates.
compiler/modes.m
compiler/modecheck_call.m
compiler/unique_modes.m
Don't call propagate_type_info_mode_list since that has
already been done in typecheck.m.
compiler/intermod.m
Write out the declared arg_modes, since these don't contain
constructs such $typed_inst which the parser doesn't handle.
compiler/clause_to_proc.m
compiler/unify_proc.m
Fill in the declared_argmodes field in proc_infos.
compiler/type_util.m
Avoid creating the substitution multiple times in type_constructors.
Index: clause_to_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.13
diff -u -r1.13 clause_to_proc.m
--- clause_to_proc.m 1997/02/23 06:05:24 1.13
+++ clause_to_proc.m 1997/03/16 03:12:51
@@ -87,9 +87,9 @@
Determinism = det,
pred_info_context(PredInfo0, Context),
MaybePredArgLives = no,
- add_new_proc(PredInfo0, PredArity, PredArgModes,
- MaybePredArgLives, yes(Determinism), Context,
- PredInfo, _ProcId)
+ add_new_proc(PredInfo0, PredArity, PredArgModes,
+ yes(PredArgModes), MaybePredArgLives, yes(Determinism),
+ Context, PredInfo, _ProcId)
;
PredInfo = PredInfo0
).
Index: hlds_pred.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_pred.m,v
retrieving revision 1.27
diff -u -r1.27 hlds_pred.m
--- hlds_pred.m 1997/03/06 05:09:08 1.27
+++ hlds_pred.m 1997/03/16 03:19:13
@@ -562,9 +562,9 @@
:- interface.
-:- pred proc_info_init(arity, list(mode), maybe(list(is_live)),
- maybe(determinism), term__context, proc_info).
-:- mode proc_info_init(in, in, in, in, in, out) is det.
+:- pred proc_info_init(arity, list(mode), maybe(list(mode)),
+ maybe(list(is_live)), maybe(determinism), term__context, proc_info).
+:- mode proc_info_init(in, in, in, in, in, in, out) is det.
:- pred proc_info_set(maybe(determinism), varset, map(var, type), list(var),
list(mode), maybe(list(is_live)), hlds_goal, term__context,
@@ -681,6 +681,9 @@
:- pred proc_info_set_typeinfo_varmap(proc_info, map(tvar, var), proc_info).
:- mode proc_info_set_typeinfo_varmap(in, in, out) is det.
+:- pred proc_info_maybe_declared_argmodes(proc_info, maybe(list(mode))).
+:- mode proc_info_maybe_declared_argmodes(in, out) is det.
+
% For a set of variables V, find all the type variables in the types
% of the variables in V, and return set of typeinfo variables for
% those type variables. (find all typeinfos for variables in V).
@@ -728,8 +731,10 @@
% should be passed.
liveness_info, % the initial liveness,
% for code generation
- map(tvar, var) % typeinfo vars for
+ map(tvar, var), % typeinfo vars for
% type parameters
+ maybe(list(mode))
+ % declared modes of args
).
@@ -740,7 +745,8 @@
% This is what `det_analysis.m' wants. det_analysis.m
% will later provide the correct inferred determinism for it.
-proc_info_init(Arity, Modes, MaybeArgLives, MaybeDet, MContext, NewProc) :-
+proc_info_init(Arity, Modes, DeclaredModes, MaybeArgLives,
+ MaybeDet, MContext, NewProc) :-
map__init(BodyTypes),
goal_info_init(GoalInfo),
varset__init(BodyVarSet0),
@@ -756,7 +762,7 @@
NewProc = procedure(
MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
- ArgInfo, InitialLiveness, TVarsMap
+ ArgInfo, InitialLiveness, TVarsMap, DeclaredModes
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -766,7 +772,7 @@
ProcInfo = procedure(
DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
HeadLives, Goal, Context, StackSlots, InferredDetism,
- CanProcess, ArgInfo, Liveness, TVarMap).
+ CanProcess, ArgInfo, Liveness, TVarMap, no).
proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
Context, TVarMap, ProcInfo) :-
@@ -775,13 +781,13 @@
MaybeHeadLives = no,
ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
- Liveness, TVarMap).
+ Liveness, TVarMap, no).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, ProcInfo) :-
ProcInfo0 = procedure(A, _, _, _, E, F, _,
- H, I, J, K, L, M, N),
+ H, I, J, K, L, M, N, O),
ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
- H, I, J, K, L, M, N).
+ H, I, J, K, L, M, N, O).
proc_info_interface_determinism(ProcInfo, Determinism) :-
proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -825,43 +831,51 @@
proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap) :-
proc_info_headvars(ProcInfo, HeadVars),
proc_info_argmodes(ProcInfo, ArgModes),
- mode_list_get_initial_insts(ArgModes, ModuleInfo, InitialInsts0),
- % propagate type information into the modes
- proc_info_vartypes(ProcInfo, VarTypes),
- map__apply_to_list(HeadVars, VarTypes, ArgTypes),
- propagate_type_info_inst_list(ArgTypes, ModuleInfo, InitialInsts0,
- InitialInsts),
+ mode_list_get_initial_insts(ArgModes, ModuleInfo, InitialInsts),
assoc_list__from_corresponding_lists(HeadVars, InitialInsts, InstAL),
instmap__from_assoc_list(InstAL, InstMap).
proc_info_declared_determinism(ProcInfo, Detism) :-
- ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(Detism, _, _, _, _, _, _, _, _, _, _, _, _, _, _).
proc_info_variables(ProcInfo, VarSet) :-
- ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, VarSet, _, _, _, _, _, _, _, _, _, _, _, _, _).
proc_info_vartypes(ProcInfo, VarTypes) :-
- ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, VarTypes, _, _, _, _, _,
+ _, _, _, _, _, _, _).
proc_info_headvars(ProcInfo, HeadVars) :-
- ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, HeadVars, _, _, _, _, _,
+ _, _, _, _, _, _).
proc_info_argmodes(ProcInfo, Modes) :-
- ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, Modes, _, _, _, _, _, _, _, _, _, _).
proc_info_maybe_arglives(ProcInfo, ArgLives) :-
- ProcInfo = procedure(_, _, _, _, _, ArgLives, _, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, ArgLives, _, _, _,
+ _, _, _, _, _, _).
proc_info_goal(ProcInfo, Goal) :-
- ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, Goal, _, _, _, _, _, _, _, _).
proc_info_context(ProcInfo, Context) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, Context, _, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, Context,
+ _, _, _, _, _, _, _).
proc_info_stack_slots(ProcInfo, StackSlots) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots, _, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, StackSlots,
+ _, _, _, _, _, _).
proc_info_inferred_determinism(ProcInfo, Detism) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, Detism, _, _, _, _, _).
proc_info_can_process(ProcInfo, CanProcess) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess, _, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, CanProcess,
+ _, _, _, _).
proc_info_arg_info(ProcInfo, ArgInfo) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo, _, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, ArgInfo,
+ _, _, _).
proc_info_liveness_info(ProcInfo, Liveness) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness, _).
+ ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, Liveness,
+ _, _).
proc_info_typeinfo_varmap(ProcInfo, TVarMap) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, TVarMap).
+ ProcInfo = procedure(_, _, _, _, _, _, _,
+ _, _, _, _, _, _, TVarMap, _).
+
+proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) :-
+ ProcInfo = procedure(_, _, _, _, _, _, _,
+ _, _, _, _, _, _, _, MaybeArgModes).
% :- type proc_info ---> procedure(
% A maybe(determinism),% _declared_ detism
@@ -884,59 +898,69 @@
% M liveness_info % the initial liveness
% N map(tvar, var) % typeinfo vars to
% % vars.
+% O maybe(list(mode)) % declared modes
+% % of args
% ).
proc_info_set_varset(ProcInfo0, VarSet, ProcInfo) :-
- ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, VarSet, C, D, E, F, G, H, I, J, K, L, M, N, O).
proc_info_set_variables(ProcInfo0, Vars, ProcInfo) :-
- ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, Vars, C, D, E, F, G, H, I, J, K, L, M, N, O).
proc_info_set_vartypes(ProcInfo0, Vars, ProcInfo) :-
- ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, B, Vars, D, E, F, G, H, I, J, K, L, M, N, O).
proc_info_set_headvars(ProcInfo0, HeadVars, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, B, C, HeadVars, E, F, G, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, B, C, HeadVars, E, F, G, H,
+ I, J, K, L, M, N, O).
proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, B, C, D, ArgModes, F, G, H, I,
+ J, K, L, M, N, O).
proc_info_set_maybe_arglives(ProcInfo0, ArgLives, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, B, C, D, E, ArgLives, G, H, I, J,
+ K, L, M, N, O).
proc_info_set_inferred_determinism(ProcInfo0, Detism, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, Detism, K, L, M, N, O).
proc_info_set_can_process(ProcInfo0, CanProcess, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess, L, M, N).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, CanProcess,
+ L, M, N, O).
proc_info_set_goal(ProcInfo0, Goal, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N),
- ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N).
+ ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O),
+ ProcInfo = procedure(A, B, C, D, E, F, Goal, H, I, J, K, L, M, N, O).
proc_info_set_stack_slots(ProcInfo0, StackSlots, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots, J, K, L, M, N).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, StackSlots,
+ J, K, L, M, N, O).
proc_info_set_arg_info(ProcInfo0, ArgInfo, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo, M, N).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, ArgInfo,
+ M, N, O).
proc_info_set_liveness_info(ProcInfo0, Liveness, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness, N).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, Liveness,
+ N, O).
proc_info_set_typeinfo_varmap(ProcInfo0, TVarMap, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, TVarMap).
+ ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O),
+ ProcInfo = procedure(A, B, C, D, E, F, G, H, I,
+ J, K, L, M, TVarMap, O).
proc_info_get_used_typeinfos_setwise(ProcInfo, Vars, TypeInfoVars) :-
set__to_sorted_list(Vars, VarList),
Index: intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.19
diff -u -r1.19 intermod.m
--- intermod.m 1997/03/06 05:09:12 1.19
+++ intermod.m 1997/03/17 03:21:42
@@ -170,11 +170,15 @@
{ pred_info_procedures(PredInfo0, Procs) },
{ map__lookup(Procs, ProcId, ProcInfo) },
{ proc_info_goal(ProcInfo, Goal) },
+ { pred_info_get_marker_list(PredInfo0, Markers) },
(
% Don't export builtins since they will be
% recreated in the importing module anyway.
{ \+ code_util__compiler_generated(PredInfo0) },
{ \+ code_util__predinfo_is_builtin(PredInfo0) },
+ % The compiler may have difficulty parsing
+ % inferred modes due to $typed_inst etc.
+ { \+ list__member(request(infer_modes), Markers) },
(
{ inlining__is_simple_goal(Goal,
InlineThreshold) }
@@ -440,7 +444,8 @@
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_import_status(PredInfo, Status) },
{ pred_info_procids(PredInfo, ProcIds) },
- ( { ProcIds = [] } ->
+ { pred_info_get_marker_list(PredInfo, Markers) },
+ ( { list__member(request(infer_modes), Markers) } ->
% Don't write this pred if it calls preds without mode decls.
{ DoWrite = no }
;
@@ -857,12 +862,13 @@
intermod__write_pred_modes(_, _, _, []) --> [].
intermod__write_pred_modes(Procs, SymName, PredOrFunc, [ProcId | ProcIds]) -->
{ map__lookup(Procs, ProcId, ProcInfo) },
- { proc_info_argmodes(ProcInfo, ArgModes) },
+ { proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) },
{ proc_info_declared_determinism(ProcInfo, MaybeDetism) },
- { MaybeDetism = yes(Detism0) ->
+ { MaybeArgModes = yes(ArgModes0), MaybeDetism = yes(Detism0) ->
+ ArgModes = ArgModes0,
Detism = Detism0
;
- error("Attempt to write pred mode decl without det decl")
+ error("intermod__write_pred_modes: attempt to write undeclared mode")
},
{ proc_info_context(ProcInfo, Context) },
{ varset__init(Varset) },
@@ -980,13 +986,17 @@
intermod__write_c_clauses(Procs, [ProcId | ProcIds], PredOrFunc,
CCode, MayCallMercury, Vars, Varset, SymName) -->
{ map__lookup(Procs, ProcId, ProcInfo) },
- { proc_info_argmodes(ProcInfo, ArgModes) },
- { get_pragma_c_code_vars(Vars, Varset, ArgModes, PragmaVars) },
- % XXX will need modification for nondet pragma C code
- mercury_output_pragma_c_code(MayCallMercury, SymName, PredOrFunc,
- PragmaVars, no, Varset, CCode),
- intermod__write_c_clauses(Procs, ProcIds, PredOrFunc, CCode,
- MayCallMercury, Vars, Varset, SymName).
+ { proc_info_maybe_declared_argmodes(ProcInfo, MaybeArgModes) },
+ ( { MaybeArgModes = yes(ArgModes) } ->
+ { get_pragma_c_code_vars(Vars, Varset, ArgModes, PragmaVars) },
+ % XXX will need modification for nondet pragma C code
+ mercury_output_pragma_c_code(MayCallMercury, SymName,
+ PredOrFunc, PragmaVars, no, Varset, CCode),
+ intermod__write_c_clauses(Procs, ProcIds, PredOrFunc, CCode,
+ MayCallMercury, Vars, Varset, SymName)
+ ;
+ { error("intermod__write_c_clauses: no mode declaration") }
+ ).
:- pred get_pragma_c_code_vars(list(var)::in, varset::in,
list(mode)::in, list(pragma_var)::out) is det.
Index: lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.24
diff -u -r1.24 lambda.m
--- lambda.m 1997/02/23 06:06:43 1.24
+++ lambda.m 1997/03/18 23:43:53
@@ -332,8 +332,10 @@
% come before all the outputs.
permute_argvars(AllArgVars, AllArgModes, ModuleInfo1,
- PermutedArgVars, PermutedArgModes),
+ PermutedArgVars, PermutedArgModes0),
map__apply_to_list(PermutedArgVars, VarTypes, ArgTypes),
+ propagate_type_info_mode_list(ArgTypes, ModuleInfo1,
+ PermutedArgModes0, PermutedArgModes),
% Now construct the proc_info and pred_info for the new
% single-mode predicate, using the information computed above
Index: make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.225
diff -u -r1.225 make_hlds.m
--- make_hlds.m 1997/03/06 05:09:22 1.225
+++ make_hlds.m 1997/03/16 03:23:52
@@ -40,9 +40,10 @@
unify_main_context, unify_sub_contexts, hlds_goal).
:- mode create_atomic_unification(in, in, in, in, in, out) is det.
-:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(is_live)),
- maybe(determinism), term__context, pred_info, proc_id).
-:- mode add_new_proc(in, in, in, in, in, in, out, out) is det.
+:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)),
+ maybe(list(is_live)), maybe(determinism),
+ term__context, pred_info, proc_id).
+:- mode add_new_proc(in, in, in, in, in, in, in, out, out) is det.
:- pred clauses_info_init(int::in, clauses_info::out) is det.
@@ -1207,8 +1208,8 @@
pred_info_init(ModuleName, PredName, Arity, TVarSet, ArgTypes, Cond,
Context, ClausesInfo0, Status, no, none, predicate, PredInfo0),
ArgLives = no,
- add_new_proc(PredInfo0, Arity, ArgModes, ArgLives, yes(Det), Context,
- PredInfo, _),
+ add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
+ ArgLives, yes(Det), Context, PredInfo, _),
module_info_get_predicate_table(Module0, PredicateTable0),
predicate_table_insert(PredicateTable0, PredInfo, PredId,
@@ -1247,12 +1248,12 @@
Status = Status1
).
-add_new_proc(PredInfo0, Arity, ArgModes, MaybeArgLives, MaybeDet, Context,
- PredInfo, ModeId) :-
+add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes,
+ MaybeArgLives, MaybeDet, Context, PredInfo, ModeId) :-
pred_info_procedures(PredInfo0, Procs0),
next_mode_id(Procs0, MaybeDet, ModeId),
- proc_info_init(Arity, ArgModes, MaybeArgLives, MaybeDet, Context,
- NewProc),
+ proc_info_init(Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives,
+ MaybeDet, Context, NewProc),
map__set(Procs0, ModeId, NewProc, Procs),
pred_info_set_procedures(PredInfo0, Procs, PredInfo).
@@ -1326,8 +1327,8 @@
% XXX we should check that this mode declaration
% isn't the same as an existing one
{ ArgLives = no },
- { add_new_proc(PredInfo0, Arity, Modes, ArgLives, MaybeDet, MContext,
- PredInfo, _) },
+ { add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
+ MaybeDet, MContext, PredInfo, _) },
{ map__set(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
Index: mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.83
diff -u -r1.83 mode_util.m
--- mode_util.m 1997/02/28 05:30:31 1.83
+++ mode_util.m 1997/03/18 00:30:32
@@ -203,19 +203,13 @@
list(mode)).
:- mode propagate_type_info_mode_list(in, in, in, out) is det.
- % Given corresponding lists of types and insts, produce a new
- % list of insts which includes the information provided by the
- % corresponding types.
+ % Given corresponding lists of types and insts and a substitution
+ % for the type variables in the type, produce a new list of insts
+ % which includes the information provided by the corresponding types.
%
-:- pred propagate_type_info_inst_list(list(type), module_info, list(inst),
- list(inst)).
-:- mode propagate_type_info_inst_list(in, in, in, out) is det.
-
- % Given a type and an inst, produce a new inst which includes
- % the information provided by the type.
- %
-:- pred propagate_type_info_inst(type, module_info, inst, inst).
-:- mode propagate_type_info_inst(in, in, in, out) is det.
+:- pred propagate_type_info_inst_list(list(type), tsubst, module_info,
+ list(inst), list(inst)).
+:- mode propagate_type_info_inst_list(in, in, in, in, out) is det.
% Given the mode of a predicate,
% work out which arguments are live (might be used again
@@ -369,7 +363,7 @@
type_constructors(Type, ModuleInfo, Constructors),
type_is_no_tag_type(Constructors, FunctorName, ArgType)
->
- % if so, the arg_mode will be determined by the mode and
+ % the arg_mode will be determined by the mode and
% type of the functor's argument,
% so we figure out the mode and type of the argument,
% and then recurse
@@ -1037,11 +1031,13 @@
Inst = abstract_inst(Name, Args)
)
; InstName = typed_ground(Uniq, Type),
- propagate_type_info_inst(Type, ModuleInfo, ground(Uniq, no),
- Inst)
+ map__init(Subst),
+ propagate_type_info_inst(Type, Subst, ModuleInfo,
+ ground(Uniq, no), Inst)
; InstName = typed_inst(Type, TypedInstName),
inst_lookup_2(TypedInstName, ModuleInfo, Inst0),
- propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst)
+ map__init(Subst),
+ propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst)
),
!.
@@ -1051,8 +1047,6 @@
% list of modes which includes the information provided by the
% corresponding types.
-:- propagate_type_info_mode_list(A, B, _, _) when A and B.
-
propagate_type_info_mode_list([], _, [], []).
propagate_type_info_mode_list([Type | Types], ModuleInfo, [Mode0 | Modes0],
[Mode | Modes]) :-
@@ -1063,16 +1057,14 @@
propagate_type_info_mode_list([_|_], _, [], []) :-
error("propagate_type_info_mode_list: length mismatch").
-:- propagate_type_info_inst_list(A, B, _, _) when A and B.
-
-propagate_type_info_inst_list([], _, [], []).
-propagate_type_info_inst_list([Type | Types], ModuleInfo, [Inst0 | Insts0],
- [Inst | Insts]) :-
- propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst),
- propagate_type_info_inst_list(Types, ModuleInfo, Insts0, Insts).
-propagate_type_info_inst_list([], _, [_|_], []) :-
+propagate_type_info_inst_list([], _, _, [], []).
+propagate_type_info_inst_list([Type | Types], Subst, ModuleInfo,
+ [Inst0 | Insts0], [Inst | Insts]) :-
+ propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst),
+ propagate_type_info_inst_list(Types, Subst, ModuleInfo, Insts0, Insts).
+propagate_type_info_inst_list([], _, _, [_|_], []) :-
error("propagate_type_info_inst_list: length mismatch").
-propagate_type_info_inst_list([_|_], _, [], []) :-
+propagate_type_info_inst_list([_|_], _, _, [], []) :-
error("propagate_type_info_inst_list: length mismatch").
% Given a type and a mode, produce a new mode which includes
@@ -1083,45 +1075,31 @@
propagate_type_info_mode(Type, ModuleInfo, Mode0, Mode) :-
mode_get_insts(ModuleInfo, Mode0, InitialInst0, FinalInst0),
- ex_propagate_type_info_inst(Type, ModuleInfo, InitialInst0,
+ map__init(Subst),
+ ex_propagate_type_info_inst(Type, Subst, ModuleInfo, InitialInst0,
InitialInst),
- ex_propagate_type_info_inst(Type, ModuleInfo, FinalInst0, FinalInst),
+ ex_propagate_type_info_inst(Type, Subst, ModuleInfo, FinalInst0,
+ FinalInst),
Mode = (InitialInst -> FinalInst).
- % Given a type and an inst, produce a new inst which includes
- % the information provided by the type.
+ % Given a type, an inst and a substitution for the type variables in
+ % the type, produce a new inst which includes the information provided
+ % by the type.
+ %
+:- pred propagate_type_info_inst(type, tsubst, module_info, inst, inst).
+:- mode propagate_type_info_inst(in, in, in, in, out) is det.
-propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst) :-
- (
- type_constructors(Type, ModuleInfo, Constructors)
- ->
- % Many of the calls to this predicate from inst_match.m do
- % not require expansion of ground insts to bound insts.
- % At the moment the extra expansion only complicates the insts
- % unnecessarily, so this is disabled.
- % propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
- % Inst)
- ex_propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
- Inst)
- ;
- Inst = Inst0
- ).
+propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst) :-
+ ex_propagate_ctor_info(Inst0, Type, Subst, ModuleInfo, Inst).
% Given a type and an inst, produce a new inst which includes
% the information provided by the type.
-:- pred ex_propagate_type_info_inst(type, module_info, inst, inst).
-:- mode ex_propagate_type_info_inst(in, in, in, out) is det.
+:- pred ex_propagate_type_info_inst(type, tsubst, module_info, inst, inst).
+:- mode ex_propagate_type_info_inst(in, in, in, in, out) is det.
-ex_propagate_type_info_inst(Type, ModuleInfo, Inst0, Inst) :-
- (
- type_constructors(Type, ModuleInfo, Constructors)
- ->
- ex_propagate_ctor_info(Inst0, Type, Constructors, ModuleInfo,
- Inst)
- ;
- Inst = Inst0
- ).
+ex_propagate_type_info_inst(Type, Subst, ModuleInfo, Inst0, Inst) :-
+ ex_propagate_ctor_info(Inst0, Type, Subst, ModuleInfo, Inst).
%-----------------------------------------------------------------------------%
@@ -1135,9 +1113,10 @@
propagate_ctor_info(free(_), _, _, _, _) :-
error("propagate_ctor_info: type info already present").
-propagate_ctor_info(bound(Uniq, BoundInsts0), Type, Constructors, ModuleInfo,
+propagate_ctor_info(bound(Uniq, BoundInsts0), Type, _Constructors, ModuleInfo,
Inst) :-
- propagate_ctor_info_2(BoundInsts0, Type, Constructors, ModuleInfo,
+ map__init(Subst),
+ propagate_ctor_info_2(BoundInsts0, Type, Subst, ModuleInfo,
BoundInsts),
( BoundInsts = [] ->
Inst = not_reached
@@ -1165,7 +1144,7 @@
inst_lookup(ModuleInfo, InstName, Inst0),
propagate_ctor_info(Inst0, Type, Ctors, ModuleInfo, Inst).
-:- pred ex_propagate_ctor_info(inst, type, list(constructor), module_info, inst).
+:- pred ex_propagate_ctor_info(inst, type, tsubst, module_info, inst).
:- mode ex_propagate_ctor_info(in, in, in, in, out) is det.
% ex_propagate_ctor_info(free, Type, _, _, free(Type)). % temporarily disabled
@@ -1175,10 +1154,10 @@
% XXX loses type info!
ex_propagate_ctor_info(free(_), _, _, _, _) :-
error("ex_propagate_ctor_info: type info already present").
-ex_propagate_ctor_info(bound(Uniq, BoundInsts0), Type, Constructors,
+ex_propagate_ctor_info(bound(Uniq, BoundInsts0), Type, Subst,
ModuleInfo, Inst) :-
- propagate_ctor_info_2(BoundInsts0, Type, Constructors, ModuleInfo,
- BoundInsts),
+ propagate_ctor_info_2(BoundInsts0, Type, Subst,
+ ModuleInfo, BoundInsts),
( BoundInsts = [] ->
Inst = not_reached
;
@@ -1194,14 +1173,18 @@
% for higher-order pred modes, the information we need is already
% in the inst, so we leave it unchanged
ground(Uniq, yes(PredInstInfo))).
-ex_propagate_ctor_info(not_reached, _Type, _Constructors, _ModuleInfo,
- not_reached).
+ex_propagate_ctor_info(not_reached, _Type, _, _ModuleInfo, not_reached).
ex_propagate_ctor_info(inst_var(_), _, _, _, _) :-
error("propagate_ctor_info: unbound inst var").
ex_propagate_ctor_info(abstract_inst(Name, Args), _, _, _,
abstract_inst(Name, Args)). % XXX loses info
-ex_propagate_ctor_info(defined_inst(InstName), Type, _, _,
- defined_inst(typed_inst(Type, InstName))).
+ex_propagate_ctor_info(defined_inst(InstName), Type0, Subst, _,
+ defined_inst(typed_inst(Type, InstName))) :-
+ ( map__is_empty(Subst) ->
+ Type = Type0
+ ;
+ term__apply_substitution(Type0, Subst, Type)
+ ).
:- pred constructors_to_bound_insts(list(constructor), uniqueness, module_info,
list(bound_inst)).
@@ -1228,18 +1211,29 @@
Inst = ground(Uniq, no),
ctor_arg_list_to_inst_list(Args, Uniq, Insts).
-:- pred propagate_ctor_info_2(list(bound_inst), (type), list(constructor),
+:- pred propagate_ctor_info_2(list(bound_inst), (type), tsubst,
module_info, list(bound_inst)).
:- mode propagate_ctor_info_2(in, in, in, in, out) is det.
-propagate_ctor_info_2(BoundInsts0, Type, Constructors,
- ModuleInfo, BoundInsts) :-
+propagate_ctor_info_2(BoundInsts0, Type0, Subst, ModuleInfo, BoundInsts) :-
+ ( map__is_empty(Subst) ->
+ Type = Type0
+ ;
+ term__apply_substitution(Type0, Subst, Type)
+ ),
(
- type_to_type_id(Type, TypeId, _),
- TypeId = qualified(TypeModule, _) - _
+ type_to_type_id(Type, TypeId, TypeArgs),
+ TypeId = qualified(TypeModule, _) - _,
+ module_info_types(ModuleInfo, TypeTable),
+ map__search(TypeTable, TypeId, TypeDefn),
+ hlds_data__get_type_defn_tparams(TypeDefn, TypeParams0),
+ hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+ TypeBody = du_type(Constructors, _, _)
->
- propagate_ctor_info_3(BoundInsts0, TypeModule,
- Constructors, ModuleInfo, BoundInsts1),
+ term__term_list_to_var_list(TypeParams0, TypeParams),
+ map__from_corresponding_lists(TypeParams, TypeArgs, ArgSubst),
+ propagate_ctor_info_3(BoundInsts0, TypeModule, Constructors,
+ ArgSubst, ModuleInfo, BoundInsts1),
list__sort(BoundInsts1, BoundInsts)
;
% Builtin types don't need processing.
@@ -1247,12 +1241,12 @@
).
:- pred propagate_ctor_info_3(list(bound_inst), string, list(constructor),
- module_info, list(bound_inst)).
-:- mode propagate_ctor_info_3(in, in, in, in, out) is det.
+ tsubst, module_info, list(bound_inst)).
+:- mode propagate_ctor_info_3(in, in, in, in, in, out) is det.
-propagate_ctor_info_3([], _, _, _, []).
+propagate_ctor_info_3([], _, _, _, _, []).
propagate_ctor_info_3([BoundInst0 | BoundInsts0], TypeModule, Constructors,
- ModuleInfo, [BoundInst | BoundInsts]) :-
+ Subst, ModuleInfo, [BoundInst | BoundInsts]) :-
BoundInst0 = functor(ConsId0, ArgInsts0),
( ConsId0 = cons(unqualified(Name), Ar) ->
ConsId = cons(qualified(TypeModule, Name), Ar)
@@ -1272,7 +1266,7 @@
CtorArg = _ArgName - ArgType
)),
list__map(GetArgTypes, Args, ArgTypes),
- propagate_type_info_inst_list(ArgTypes,
+ propagate_type_info_inst_list(ArgTypes, Subst,
ModuleInfo, ArgInsts0, ArgInsts),
BoundInst = functor(ConsId, ArgInsts)
;
@@ -1283,7 +1277,7 @@
BoundInst = functor(ConsId, ArgInsts0)
),
propagate_ctor_info_3(BoundInsts0, TypeModule,
- Constructors, ModuleInfo, BoundInsts).
+ Constructors, Subst, ModuleInfo, BoundInsts).
%-----------------------------------------------------------------------------%
Index: modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.8
diff -u -r1.8 modecheck_call.m
--- modecheck_call.m 1997/03/06 05:09:34 1.8
+++ modecheck_call.m 1997/03/17 01:21:58
@@ -84,12 +84,13 @@
list__length(Modes0, Arity)
->
Det = Det0,
+ Modes = Modes0,
%
% Check that `Args0' have livenesses which match the
% expected livenesses.
%
- get_arg_lives(Modes0, ModuleInfo0, ExpectedArgLives),
+ get_arg_lives(Modes, ModuleInfo0, ExpectedArgLives),
modecheck_var_list_is_live(Args0, ExpectedArgLives, 1,
ModeInfo0, ModeInfo1),
@@ -98,9 +99,6 @@
% initial insts, and set their new final insts (introducing
% extra unifications for implied modes, if necessary).
%
- % propagate type info into modes
- propagate_type_info_mode_list(Types, ModuleInfo0, Modes0,
- Modes),
mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts),
modecheck_var_has_inst_list(Args0, InitialInsts, 1,
ModeInfo1, ModeInfo2),
@@ -158,7 +156,7 @@
->
TheProcId = ProcId,
map__lookup(Procs, ProcId, ProcInfo),
- proc_info_argmodes(ProcInfo, ProcArgModes0),
+ proc_info_argmodes(ProcInfo, ProcArgModes),
proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
%
@@ -168,11 +166,6 @@
modecheck_var_list_is_live(ArgVars0, ProcArgLives0, 0,
ModeInfo0, ModeInfo1),
- % propagate type info into modes
- mode_info_get_types_of_vars(ModeInfo0, ArgVars0, ArgTypes),
- propagate_type_info_mode_list(ArgTypes, ModuleInfo,
- ProcArgModes0, ProcArgModes),
-
%
% Check that `ArgsVars0' have insts which match the expected
% initial insts, and set their new final insts (introducing
@@ -252,13 +245,9 @@
% find the initial insts and the final livenesses
% of the arguments for this mode of the called pred
map__lookup(Procs, ProcId, ProcInfo),
- proc_info_argmodes(ProcInfo, ProcArgModes0),
+ proc_info_argmodes(ProcInfo, ProcArgModes),
mode_info_get_module_info(ModeInfo0, ModuleInfo),
proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
- % propagate the type information into the modes
- mode_info_get_types_of_vars(ModeInfo0, ArgVars0, ArgTypes),
- propagate_type_info_mode_list(ArgTypes, ModuleInfo,
- ProcArgModes0, ProcArgModes),
mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
% check whether the livenesses of the args matches their
@@ -322,8 +311,8 @@
MaybeDeterminism = no,
% create the new mode
- add_new_proc(PredInfo0, Arity, Modes, yes(ArgLives), MaybeDeterminism,
- Context, PredInfo1, ProcId),
+ add_new_proc(PredInfo0, Arity, Modes, no, yes(ArgLives),
+ MaybeDeterminism, Context, PredInfo1, ProcId),
% copy the clauses for the predicate to this procedure,
% and then store the new proc_info and pred_info
Index: modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.11
diff -u -r1.11 modecheck_unify.m
--- modecheck_unify.m 1997/03/06 05:09:37 1.11
+++ modecheck_unify.m 1997/03/18 00:30:28
@@ -377,7 +377,11 @@
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
% initialize the initial insts of the lambda variables
- mode_list_get_initial_insts(Modes, ModuleInfo0, VarInitialInsts),
+ mode_list_get_initial_insts(Modes, ModuleInfo0, VarInitialInsts0),
+ mode_info_get_types_of_vars(ModeInfo0, Vars, VarTypes),
+ map__init(TSubst),
+ propagate_type_info_inst_list(VarTypes, TSubst,
+ ModuleInfo0, VarInitialInsts0, VarInitialInsts),
assoc_list__from_corresponding_lists(Vars, VarInitialInsts, VarInstAL),
instmap_delta_from_assoc_list(VarInstAL, VarInstMapDelta),
mode_info_get_instmap(ModeInfo0, InstMap0),
Index: modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.195
diff -u -r1.195 modes.m
--- modes.m 1997/02/23 06:07:29 1.195
+++ modes.m 1997/03/17 03:15:07
@@ -490,21 +490,16 @@
;
proc_info_context(ProcInfo0, Context)
),
- % extract the predicate's type from the pred_info
- % and propagate the type information into the modes
- pred_info_arg_types(PredInfo, _TypeVars, ArgTypes),
- propagate_type_info_mode_list(ArgTypes, ModuleInfo0, ArgModes0,
- ArgModes1),
% modecheck the clause - first set the initial instantiation
% of the head arguments, mode-check the body, and
% then check that the final instantiation matches that in
% the mode declaration
- mode_list_get_initial_insts(ArgModes1, ModuleInfo0, ArgInitialInsts),
+ mode_list_get_initial_insts(ArgModes0, ModuleInfo0, ArgInitialInsts),
assoc_list__from_corresponding_lists(HeadVars, ArgInitialInsts, InstAL),
instmap__from_assoc_list(InstAL, InstMap0),
% initially, only the non-clobbered head variables are live
- mode_list_get_final_insts(ArgModes1, ModuleInfo0, ArgFinalInsts0),
+ mode_list_get_final_insts(ArgModes0, ModuleInfo0, ArgFinalInsts0),
get_live_vars(HeadVars, ArgLives0, LiveVarsList),
set__list_to_set(LiveVarsList, LiveVars),
mode_info_init(IOState0, ModuleInfo0, PredId, ProcId,
Index: type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.39
diff -u -r1.39 type_util.m
--- type_util.m 1997/02/23 06:08:21 1.39
+++ type_util.m 1997/03/13 11:35:25
@@ -364,29 +364,28 @@
Constructors = Constructors0
;
term__term_list_to_var_list(TypeParams0, TypeParams),
- substitute_type_args_2(Constructors0, TypeParams, TypeArgs,
- Constructors)
+ map__from_corresponding_lists(TypeParams, TypeArgs, Subst),
+ substitute_type_args_2(Constructors0, Subst, Constructors)
).
-:- pred substitute_type_args_2(list(constructor), list(var), list(type),
+:- pred substitute_type_args_2(list(constructor), substitution,
list(constructor)).
-:- mode substitute_type_args_2(in, in, in, out) is det.
+:- mode substitute_type_args_2(in, in, out) is det.
-substitute_type_args_2([], _TypeParams, _TypeArgs, []).
-substitute_type_args_2([Name - Args0 | Ctors0], TypeParams, TypeArgs,
+substitute_type_args_2([], _, []).
+substitute_type_args_2([Name - Args0 | Ctors0], Subst,
[Name - Args | Ctors]) :-
- substitute_type_args_3(Args0, TypeParams, TypeArgs, Args),
- substitute_type_args_2(Ctors0, TypeParams, TypeArgs, Ctors).
+ substitute_type_args_3(Args0, Subst, Args),
+ substitute_type_args_2(Ctors0, Subst, Ctors).
-:- pred substitute_type_args_3(list(constructor_arg), list(var), list(type),
+:- pred substitute_type_args_3(list(constructor_arg), substitution,
list(constructor_arg)).
-:- mode substitute_type_args_3(in, in, in, out) is det.
+:- mode substitute_type_args_3(in, in, out) is det.
-substitute_type_args_3([], _TypeParams, _TypeArgs, []).
-substitute_type_args_3([Name - Arg0 | Args0], TypeParams, TypeArgs,
- [Name - Arg | Args]) :-
- term__substitute_corresponding(TypeParams, TypeArgs, Arg0, Arg),
- substitute_type_args_3(Args0, TypeParams, TypeArgs, Args).
+substitute_type_args_3([], _, []).
+substitute_type_args_3([Name - Arg0 | Args0], Subst, [Name - Arg | Args]) :-
+ term__apply_substitution(Arg0, Subst, Arg),
+ substitute_type_args_3(Args0, Subst, Args).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.189
diff -u -r1.189 typecheck.m
--- typecheck.m 1997/02/26 09:47:55 1.189
+++ typecheck.m 1997/03/17 01:07:22
@@ -230,19 +230,43 @@
ModuleInfo0, ModuleInfo, Error0, Error, Changed0, Changed) -->
{ module_info_preds(ModuleInfo0, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
+ { pred_info_procids(PredInfo0, ProcIds) },
(
{ pred_info_is_imported(PredInfo0) }
->
{ Error1 = Error0 },
- { ModuleInfo1 = ModuleInfo0 },
- { Changed2 = Changed0 }
+
+ %
+ % Ensure that all constructors occurring in predicate mode
+ % declarations are module qualified.
+ %
+ {
+ pred_info_arg_types(PredInfo0, _, ArgTypes),
+ pred_info_procedures(PredInfo0, Procs0),
+ typecheck_propagate_type_info_into_proc_modes(
+ ModuleInfo0, ProcIds, ArgTypes, Procs0, Procs),
+ pred_info_set_procedures(PredInfo0, Procs, PredInfo),
+ map__set(Preds0, PredId, PredInfo, Preds),
+ module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1),
+ Changed2 = Changed0
+ }
;
typecheck_pred_type(PredId, PredInfo0, ModuleInfo0,
MaybePredInfo, Changed1),
{
MaybePredInfo = yes(PredInfo1),
Error1 = Error0,
- map__set(Preds0, PredId, PredInfo1, Preds),
+
+ %
+ % Ensure that all constructors occurring in predicate
+ % mode declarations are module qualified.
+ %
+ pred_info_arg_types(PredInfo1, _, ArgTypes),
+ pred_info_procedures(PredInfo1, Procs1),
+ typecheck_propagate_type_info_into_proc_modes(
+ ModuleInfo0, ProcIds, ArgTypes, Procs1, Procs),
+ pred_info_set_procedures(PredInfo1, Procs, PredInfo),
+ map__set(Preds0, PredId, PredInfo, Preds),
module_info_set_preds(ModuleInfo0, Preds, ModuleInfo1)
;
MaybePredInfo = no,
@@ -254,6 +278,23 @@
),
typecheck_pred_types_2(PredIds, ModuleInfo1, ModuleInfo, Error1, Error,
Changed2, Changed).
+
+:- pred typecheck_propagate_type_info_into_proc_modes(module_info,
+ list(proc_id), list(type), proc_table, proc_table).
+:- mode typecheck_propagate_type_info_into_proc_modes(in,
+ in, in, in, out) is det.
+
+typecheck_propagate_type_info_into_proc_modes(_, [], _, Procs, Procs).
+typecheck_propagate_type_info_into_proc_modes(ModuleInfo, [ProcId | ProcIds],
+ ArgTypes, Procs0, Procs) :-
+ map__lookup(Procs0, ProcId, ProcInfo0),
+ proc_info_argmodes(ProcInfo0, ArgModes0),
+ propagate_type_info_mode_list(ArgTypes, ModuleInfo,
+ ArgModes0, ArgModes),
+ proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo),
+ map__det_update(Procs0, ProcId, ProcInfo, Procs1),
+ typecheck_propagate_type_info_into_proc_modes(ModuleInfo, ProcIds,
+ ArgTypes, Procs1, Procs).
:- pred typecheck_pred_type(pred_id, pred_info, module_info,
maybe(pred_info), bool, io__state, io__state).
Index: unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.54
diff -u -r1.54 unify_proc.m
--- unify_proc.m 1997/03/06 05:09:52 1.54
+++ unify_proc.m 1997/03/16 03:13:08
@@ -221,8 +221,8 @@
MaybeDet = yes(Determinism),
term__context_init(Context),
ArgLives = no, % XXX ArgLives should be part of the UnifyId
- add_new_proc(PredInfo0, Arity, ArgModes, ArgLives, MaybeDet,
- Context, PredInfo1, ProcId),
+ add_new_proc(PredInfo0, Arity, ArgModes, no, ArgLives,
+ MaybeDet, Context, PredInfo1, ProcId),
%
% copy the clauses for the procedure from the pred_info to the
Index: unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.33
diff -u -r1.33 unique_modes.m
--- unique_modes.m 1997/03/18 07:18:06 1.33
+++ unique_modes.m 1997/03/18 23:45:46
@@ -126,26 +126,17 @@
% Extract the useful fields in the proc_info.
%
proc_info_headvars(ProcInfo0, Args),
- proc_info_argmodes(ProcInfo0, ArgModes0),
+ proc_info_argmodes(ProcInfo0, ArgModes),
proc_info_arglives(ProcInfo0, ModuleInfo0, ArgLives),
proc_info_goal(ProcInfo0, Goal0),
%
- % extract the predicate's type from the pred_info
- % and propagate the type information into the modes
- %
- module_info_preds(ModuleInfo0, Preds),
- map__lookup(Preds, PredId, PredInfo),
- pred_info_arg_types(PredInfo, _TypeVars, ArgTypes),
- propagate_type_info_mode_list(ArgTypes, ModuleInfo0, ArgModes0,
- ArgModes),
-
- %
% Figure out the right context to use.
% We use the context of the first clause, unless
% there weren't any clauses at all, in which case
% 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),
( ClauseList = [FirstClause | _] ->
@@ -594,13 +585,9 @@
:- mode unique_modes__check_call_modes(in, in, in, in,
mode_info_di, mode_info_uo) is det.
-unique_modes__check_call_modes(ArgVars, ProcArgModes0, CodeModel, NeverSucceeds,
+unique_modes__check_call_modes(ArgVars, ProcArgModes, CodeModel, NeverSucceeds,
ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo),
- % propagate type info into modes
- mode_info_get_types_of_vars(ModeInfo0, ArgVars, ArgTypes),
- propagate_type_info_mode_list(ArgTypes, ModuleInfo,
- ProcArgModes0, ProcArgModes),
mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
InitialInsts),
modecheck_var_has_inst_list(ArgVars, InitialInsts, 0,
More information about the developers
mailing list