[m-dev.] for review: fix type specialization
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Sep 8 11:19:54 AEDT 2000
Estimated hours taken: 3
Fix type specialization of existentially typed predicates and functions.
The test case for this change is
tests/hard_coded/typeclasses/typeclass_exist_method_2.m.
compiler/higher_order.m:
Make sure that the existentially quantified type variables
are handled correctly in the code to specialize the types
when creating a specialized versions of a predicate.
compiler/inlining.m:
Undo my temporary fix for this problem.
compiler/hlds_out.m:
compiler/mercury_to_mercury.m:
compiler/intermod.m:
compiler/post_typecheck.m:
compiler/typecheck.m:
Append variable numbers to type variables in predicate
and function declarations in HLDS dumps to make this
sort of problem easier to track down in future.
Index: higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.70
diff -u -u -r1.70 higher_order.m
--- higher_order.m 2000/09/07 01:46:19 1.70
+++ higher_order.m 2000/09/07 15:09:01
@@ -2340,11 +2340,12 @@
proc_info_argmodes(NewProcInfo0, ArgModes0),
pred_info_get_exist_quant_tvars(NewPredInfo0, ExistQVars0),
pred_info_typevarset(NewPredInfo0, TypeVarSet0),
+ pred_info_arg_types(NewPredInfo0, OriginalArgTypes0),
Caller = proc(CallerPredId, CallerProcId),
module_info_pred_proc_info(ModuleInfo, CallerPredId, CallerProcId,
CallerPredInfo, CallerProcInfo),
- pred_info_arg_types(CallerPredInfo, CallerTypeVarSet, _, _),
+ pred_info_typevarset(CallerPredInfo, CallerTypeVarSet),
pred_info_get_univ_quant_tvars(CallerPredInfo, CallerHeadParams),
proc_info_typeinfo_varmap(CallerProcInfo, CallerTypeInfoVarMap0),
@@ -2354,23 +2355,34 @@
proc_info_vartypes(NewProcInfo0, VarTypes0),
varset__merge_subst(CallerTypeVarSet, TypeVarSet0,
TypeVarSet, TypeRenaming),
- apply_substitution_to_type_map(VarTypes0, TypeRenaming, VarTypes1),
+ apply_substitution_to_type_map(VarTypes0, TypeRenaming, VarTypes1),
+ term__apply_substitution_to_list(OriginalArgTypes0,
+ TypeRenaming, OriginalArgTypes1),
% the real set of existentially quantified variables may be
% smaller, but this is OK
- map__apply_to_list(ExistQVars0, TypeRenaming, ExistQTerms),
- term__term_list_to_var_list(ExistQTerms, ExistQVars),
+ term__var_list_to_term_list(ExistQVars0, ExistQTypes0),
+ term__apply_substitution_to_list(ExistQTypes0, TypeRenaming,
+ ExistQTypes1),
+ term__term_list_to_var_list(ExistQTypes1, ExistQVars1),
+
+ inlining__get_type_substitution(OriginalArgTypes1, CallerArgTypes0,
+ CallerHeadParams, ExistQVars1, TypeSubn),
+
+ term__apply_rec_substitution_to_list(ExistQTypes1, TypeSubn,
+ ExistQTypes),
+ ExistQVars = list__filter_map(
+ (func(ExistQType) = ExistQVar is semidet :-
+ ExistQType = term__variable(ExistQVar)
+ ), ExistQTypes),
- map__apply_to_list(HeadVars0, VarTypes1, HeadTypes0),
- inlining__get_type_substitution(HeadTypes0, CallerArgTypes0,
- CallerHeadParams, ExistQVars, TypeSubn),
-
- term__var_list_to_term_list(ExtraTypeInfoTVars0,
- ExtraTypeInfoTVarTypes0),
-
apply_rec_substitution_to_type_map(VarTypes1, TypeSubn, VarTypes2),
+ term__apply_rec_substitution_to_list(OriginalArgTypes1, TypeSubn,
+ OriginalArgTypes),
proc_info_set_vartypes(NewProcInfo0, VarTypes2, NewProcInfo1),
+ term__var_list_to_term_list(ExtraTypeInfoTVars0,
+ ExtraTypeInfoTVarTypes0),
( (map__is_empty(TypeSubn) ; ExistQVars = []) ->
HOArgs = HOArgs0,
ExtraTypeInfoTVarTypes = ExtraTypeInfoTVarTypes0,
@@ -2461,21 +2473,74 @@
proc_info_set_headvars(NewProcInfo4, HeadVars, NewProcInfo5),
proc_info_set_argmodes(NewProcInfo5, ArgModes, NewProcInfo6),
+ list__length(OriginalArgTypes, NumOriginalArgTypes),
+ ( list__drop(NumOriginalArgTypes, HeadVars1, NewHeadVars0) ->
+ NewHeadVars = NewHeadVars0
+ ;
+ error("higher_order__create_new_proc: list__take failed")
+ ),
+
proc_info_vartypes(NewProcInfo6, VarTypes6),
- map__apply_to_list(HeadVars, VarTypes6, ArgTypes),
+ map__apply_to_list(NewHeadVars, VarTypes6, NewHeadVarTypes0),
+ list__condense(
+ [ExtraTypeInfoTypes, OriginalArgTypes, NewHeadVarTypes0],
+ ArgTypes),
pred_info_set_arg_types(NewPredInfo0, TypeVarSet,
ExistQVars, ArgTypes, NewPredInfo1),
pred_info_set_typevarset(NewPredInfo1, TypeVarSet, NewPredInfo2),
%
+ % The types of the headvars in the vartypes map in the
+ % proc_info may be more specific than the argument types
+ % returned by pred_info_argtypes if the procedure body
+ % binds some existentially quantified type variables.
+ % The types of the extra arguments added by
+ % construct_higher_order_terms use the substitution
+ % computed based on the result pred_info_arg_types.
+ % We may need to apply a substitution to the types of the
+ % new variables in the vartypes in the proc_info.
+ %
+ % XXX We should apply this substitution to the variable
+ % types in any callers of this predicate, which may
+ % introduce other opportunities for specialization.
+ %
+ (
+ ExistQVars = []
+ ->
+ NewProcInfo7 = NewProcInfo6
+ ;
+ map__apply_to_list(HeadVars0, VarTypes6, OriginalHeadTypes),
+ (
+ type_list_subsumes(OriginalArgTypes,
+ OriginalHeadTypes, ExistentialSubn)
+ ->
+ term__apply_rec_substitution_to_list(NewHeadVarTypes0,
+ ExistentialSubn, NewHeadVarTypes),
+ assoc_list__from_corresponding_lists(NewHeadVars,
+ NewHeadVarTypes, NewHeadVarsAndTypes),
+ list__foldl(
+ (pred(VarAndType::in, Map0::in, Map::out) is det :-
+ VarAndType = Var - Type,
+ map__det_update(Map0, Var, Type, Map)
+ ),
+ NewHeadVarsAndTypes, VarTypes6, VarTypes7),
+ proc_info_set_vartypes(NewProcInfo6,
+ VarTypes7, NewProcInfo7)
+ ;
+ error(
+ "higher_order__create_new_proc: type_list_subsumes failed")
+ )
+ ),
+
+ %
% Apply the substitutions to the types in the original
% typeclass_info_varmap.
%
- proc_info_typeclass_info_varmap(NewProcInfo6, TCVarMap0),
+ proc_info_typeclass_info_varmap(NewProcInfo7, TCVarMap0),
apply_substitutions_to_typeclass_var_map(TCVarMap0, TypeRenaming,
TypeSubn, EmptyVarRenaming, TCVarMap),
- proc_info_set_typeclass_info_varmap(NewProcInfo6,
- TCVarMap, NewProcInfo7),
+ proc_info_set_typeclass_info_varmap(NewProcInfo7,
+ TCVarMap, NewProcInfo8),
%
% Find the new class context by searching the argument types
@@ -2488,7 +2553,7 @@
map__init(NewProcs0),
NewPredProcId = proc(_, NewProcId),
- map__det_insert(NewProcs0, NewProcId, NewProcInfo7, NewProcs),
+ map__det_insert(NewProcs0, NewProcId, NewProcInfo8, NewProcs),
pred_info_set_procedures(NewPredInfo3, NewProcs, NewPredInfo).
% Take an original list of headvars and arg_modes and
Index: hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.242
diff -u -u -r1.242 hlds_out.m
--- hlds_out.m 2000/09/04 22:33:39 1.242
+++ hlds_out.m 2000/09/05 13:47:59
@@ -714,6 +714,11 @@
{ pred_info_get_head_type_params(PredInfo, HeadTypeParams) },
{ pred_info_get_indexes(PredInfo, Indexes) },
globals__io_lookup_string_option(dump_hlds_options, Verbose),
+ ( { string__contains_char(Verbose, 'v') } ->
+ { AppendVarnums = yes }
+ ;
+ { AppendVarnums = no }
+ ),
( { string__contains_char(Verbose, 'C') } ->
% Information about predicates is dumped if 'C'
% suboption is on.
@@ -721,25 +726,22 @@
{ PredOrFunc = predicate },
mercury_output_pred_type(TVarSet, ExistQVars,
qualified(Module, PredName),
- ArgTypes, no, Purity, ClassContext, Context)
+ ArgTypes, no, Purity, ClassContext, Context,
+ AppendVarnums)
;
{ PredOrFunc = function },
{ pred_args_to_func_args(ArgTypes, FuncArgTypes,
FuncRetType) },
mercury_output_func_type(TVarSet, ExistQVars,
qualified(Module, PredName), FuncArgTypes,
- FuncRetType, no, Purity, ClassContext, Context)
+ FuncRetType, no, Purity, ClassContext,
+ Context, AppendVarnums)
)
;
[]
),
{ ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses,
TypeInfoMap, TypeClassInfoMap) },
- ( { string__contains_char(Verbose, 'v') } ->
- { AppendVarnums = yes }
- ;
- { AppendVarnums = no }
- ),
( { string__contains_char(Verbose, 'C') } ->
hlds_out__write_indent(Indent),
io__write_string("% pred id: "),
@@ -2340,7 +2342,7 @@
Constraint, Var) -->
hlds_out__write_indent(Indent),
io__write_string("% "),
- mercury_output_constraint(TVarSet, Constraint),
+ mercury_output_constraint(TVarSet, AppendVarnums, Constraint),
io__write_string(" -> "),
mercury_output_var(Var, VarSet, AppendVarnums),
io__nl.
@@ -2578,7 +2580,9 @@
hlds_out__write_indent(Indent),
io__write_string("% Constraints: "),
- io__write_list(Constraints, ", ", mercury_output_constraint(VarSet)),
+ { AppendVarnums = no },
+ io__write_list(Constraints, ", ",
+ mercury_output_constraint(VarSet, AppendVarnums)),
io__nl,
hlds_out__write_indent(Indent),
@@ -2714,7 +2718,9 @@
hlds_out__write_indent(Indent),
io__write_string("% Constraints: "),
- io__write_list(Constraints, ", ", mercury_output_constraint(VarSet)),
+ { AppendVarnums = no },
+ io__write_list(Constraints, ", ",
+ mercury_output_constraint(VarSet, AppendVarnums)),
io__nl,
hlds_out__write_indent(Indent),
@@ -3021,7 +3027,8 @@
hlds_out__write_constraint_proof(Indent, VarSet, Constraint - Proof) -->
hlds_out__write_indent(Indent),
io__write_string("% "),
- mercury_output_constraint(VarSet, Constraint),
+ { AppendVarnums = no },
+ mercury_output_constraint(VarSet, AppendVarnums, Constraint),
io__write_string(": "),
(
{ Proof = apply_instance(Num) },
@@ -3030,7 +3037,7 @@
;
{ Proof = superclass(Super) },
io__write_string("super class of "),
- mercury_output_constraint(VarSet, Super)
+ mercury_output_constraint(VarSet, AppendVarnums, Super)
).
%-----------------------------------------------------------------------------%
Index: inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.89
diff -u -u -r1.89 inlining.m
--- inlining.m 2000/09/07 01:46:23 1.89
+++ inlining.m 2000/09/07 12:31:28
@@ -585,7 +585,7 @@
%-----------------------------------------------------------------------------%
-inlining__do_inline_call(_, ArgVars, PredInfo, ProcInfo,
+inlining__do_inline_call(HeadTypeParams, ArgVars, PredInfo, ProcInfo,
VarSet0, VarSet, VarTypes0, VarTypes, TypeVarSet0, TypeVarSet,
TypeInfoVarMap0, TypeInfoVarMap, Goal) :-
@@ -637,12 +637,6 @@
map__apply_to_list(ArgVars, VarTypes0, ArgTypes),
pred_info_get_exist_quant_tvars(PredInfo, CalleeExistQVars),
-
- % Typechecking has already succeeded, so we don't need
- % to check for binding of head type parameters.
- % Also, existentially-typed head type parameters
- % may be bound by inlining.
- HeadTypeParams = [],
inlining__get_type_substitution(HeadTypes, ArgTypes, HeadTypeParams,
CalleeExistQVars, TypeSubn),
Index: intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.81
diff -u -u -r1.81 intermod.m
--- intermod.m 2000/08/09 07:46:46 1.81
+++ intermod.m 2000/09/05 13:48:00
@@ -1260,17 +1260,19 @@
{ pred_info_get_purity(PredInfo, Purity) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
{ pred_info_get_class_context(PredInfo, ClassContext) },
+ { AppendVarNums = yes },
(
{ PredOrFunc = predicate },
mercury_output_pred_type(TVarSet, ExistQVars,
qualified(Module, Name), ArgTypes, no, Purity,
- ClassContext, Context)
+ ClassContext, Context, AppendVarNums)
;
{ PredOrFunc = function },
{ pred_args_to_func_args(ArgTypes, FuncArgTypes, FuncRetType) },
mercury_output_func_type(TVarSet, ExistQVars,
qualified(Module, Name), FuncArgTypes,
- FuncRetType, no, Purity, ClassContext, Context)
+ FuncRetType, no, Purity, ClassContext, Context,
+ AppendVarNums)
),
{ pred_info_procedures(PredInfo, Procs) },
{ pred_info_procids(PredInfo, ProcIds) },
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.172
diff -u -u -r1.172 mercury_to_mercury.m
--- mercury_to_mercury.m 2000/08/13 13:18:44 1.172
+++ mercury_to_mercury.m 2000/09/05 13:48:01
@@ -34,16 +34,23 @@
:- pred mercury_output_item(item, prog_context, io__state, io__state).
:- mode mercury_output_item(in, in, di, uo) is det.
+ % Output a `:- pred' declaration, making sure that the variable
+ % number appears in variable names if the boolean argument
+ % is set to `yes'.
:- pred mercury_output_pred_type(tvarset, existq_tvars, sym_name, list(type),
maybe(determinism), purity, class_constraints,
- prog_context, io__state, io__state).
-:- mode mercury_output_pred_type(in, in, in, in, in, in, in, in, di, uo) is det.
+ prog_context, bool, io__state, io__state).
+:- mode mercury_output_pred_type(in, in, in, in, in, in, in, in, in,
+ di, uo) is det.
+ % Output a `:- func' declaration, making sure that the variable
+ % number appears in variable names if the boolean argument
+ % is set to `yes'.
:- pred mercury_output_func_type(tvarset, existq_tvars, sym_name,
list(type), type,
maybe(determinism), purity, class_constraints,
- prog_context, io__state, io__state).
-:- mode mercury_output_func_type(in, in, in, in, in, in, in, in, in,
+ prog_context, bool, io__state, io__state).
+:- mode mercury_output_func_type(in, in, in, in, in, in, in, in, in, in,
di, uo) is det.
:- pred mercury_output_pred_mode_decl(inst_varset, sym_name, list(mode),
@@ -185,17 +192,22 @@
:- pred mercury_convert_var_name(string, string).
:- mode mercury_convert_var_name(in, out) is det.
-:- pred mercury_output_constraint(tvarset, class_constraint,
+ % Output a constraint, making sure that the variable number appears
+ % in variable names if the boolean argument is set to `yes'.
+:- pred mercury_output_constraint(tvarset, bool, class_constraint,
io__state, io__state).
-:- mode mercury_output_constraint(in, in, di, uo) is det.
+:- mode mercury_output_constraint(in, in, in, di, uo) is det.
:- pred mercury_constraint_to_string(tvarset, class_constraint,
string).
:- mode mercury_constraint_to_string(in, in, out) is det.
- % output an existential quantifier
-:- pred mercury_output_quantifier(tvarset, existq_tvars, io__state, io__state).
-:- mode mercury_output_quantifier(in, in, di, uo) is det.
+ % Output an existential quantifier, making sure that the variable
+ % number appears in variable names if the boolean argument
+ % is set to `yes'.
+:- pred mercury_output_quantifier(tvarset, bool, existq_tvars,
+ io__state, io__state).
+:- mode mercury_output_quantifier(in, in, in, di, uo) is det.
:- pred mercury_output_instance_methods(instance_methods, io__state,
io__state).
@@ -455,7 +467,9 @@
),
io__write_char(')'),
- mercury_output_class_constraint_list(Constraints, VarSet, "<="),
+ { AppendVarnums = no },
+ mercury_output_class_constraint_list(Constraints, VarSet, "<=",
+ AppendVarnums),
io__write_string(" where [\n"),
@@ -475,7 +489,9 @@
io__write_char(')'),
io__write_char(')'),
- mercury_output_class_constraint_list(Constraints, VarSet, "<="),
+ { AppendVarnums = no },
+ mercury_output_class_constraint_list(Constraints, VarSet, "<=",
+ AppendVarnums),
(
{ Body = abstract }
@@ -1226,7 +1242,8 @@
mercury_output_ctor(Ctor, VarSet) -->
{ Ctor = ctor(ExistQVars, Constraints, Name, Args) },
- mercury_output_quantifier(VarSet, ExistQVars),
+ { AppendVarnums = no },
+ mercury_output_quantifier(VarSet, AppendVarnums, ExistQVars),
(
{ ExistQVars = [] }
@@ -1274,7 +1291,9 @@
[]
),
- mercury_output_class_constraint_list(Constraints, VarSet, "=>"),
+ { AppendVarnums = no },
+ mercury_output_class_constraint_list(Constraints, VarSet, "=>",
+ AppendVarnums),
(
{ ExistQVars = [] }
->
@@ -1323,33 +1342,37 @@
{ MaybeModes = yes(Modes) },
{ Modes \= [] }
->
+ { AppendVarnums = no },
mercury_output_pred_type_2(TypeVarSet, ExistQVars, PredName,
Types, MaybeDet, Purity, ClassContext, Context,
- StartString, Separator),
+ AppendVarnums, StartString, Separator),
mercury_output_pred_mode_decl_2(InstVarSet, PredName, Modes,
MaybeDet, Context, StartString, Terminator)
;
+ { AppendVarnums = no },
mercury_output_pred_type_2(TypeVarSet, ExistQVars, PredName,
Types, MaybeDet, Purity, ClassContext, Context,
- StartString, Terminator)
+ AppendVarnums, StartString, Terminator)
).
mercury_output_pred_type(VarSet, ExistQVars, PredName, Types, MaybeDet, Purity,
- ClassContext, Context) -->
+ ClassContext, Context, AppendVarnums) -->
mercury_output_pred_type_2(VarSet, ExistQVars, PredName, Types,
- MaybeDet, Purity, ClassContext, Context, ":- ", ".\n").
+ MaybeDet, Purity, ClassContext, Context, AppendVarnums,
+ ":- ", ".\n").
:- pred mercury_output_pred_type_2(tvarset, existq_tvars, sym_name, list(type),
maybe(determinism), purity, class_constraints,
- prog_context, string, string, io__state, io__state).
-:- mode mercury_output_pred_type_2(in, in, in, in, in, in, in, in, in, in,
+ prog_context, bool, string, string, io__state, io__state).
+:- mode mercury_output_pred_type_2(in, in, in, in, in, in, in, in, in, in, in,
di, uo) is det.
mercury_output_pred_type_2(VarSet, ExistQVars, PredName, Types, MaybeDet,
- Purity, ClassContext, _Context, StartString, Separator) -->
+ Purity, ClassContext, _Context, AppendVarnums,
+ StartString, Separator) -->
io__write_string(StartString),
- mercury_output_quantifier(VarSet, ExistQVars),
+ mercury_output_quantifier(VarSet, AppendVarnums, ExistQVars),
( { ExistQVars = [], ClassContext = constraints(_, []) } ->
[]
;
@@ -1362,13 +1385,15 @@
->
mercury_output_sym_name(PredName),
io__write_string("("),
- mercury_output_term(Type, VarSet, no),
- mercury_output_remaining_terms(Rest, VarSet, no),
+ mercury_output_term(Type, VarSet, AppendVarnums),
+ mercury_output_remaining_terms(Rest, VarSet, AppendVarnums),
io__write_string(")"),
- mercury_output_class_context(ClassContext, ExistQVars, VarSet)
+ mercury_output_class_context(ClassContext, ExistQVars, VarSet,
+ AppendVarnums)
;
mercury_output_bracketed_sym_name(PredName),
- mercury_output_class_context(ClassContext, ExistQVars, VarSet),
+ mercury_output_class_context(ClassContext, ExistQVars, VarSet,
+ AppendVarnums),
mercury_output_det_annotation(MaybeDet)
),
@@ -1414,35 +1439,37 @@
{ MaybeModes = yes(Modes) },
{ MaybeRetMode = yes(RetMode) }
->
+ { AppendVarnums = no },
mercury_output_func_type_2(TypeVarSet, ExistQVars, FuncName,
- Types, RetType, no, Purity, ClassContext,
- Context, StartString, Separator),
+ Types, RetType, no, Purity, ClassContext,
+ Context, AppendVarnums, StartString, Separator),
mercury_output_func_mode_decl_2(InstVarSet, FuncName, Modes,
RetMode, MaybeDet, Context,
StartString, Terminator)
;
+ { AppendVarnums = no },
mercury_output_func_type_2(TypeVarSet, ExistQVars, FuncName,
- Types, RetType, MaybeDet, Purity, ClassContext,
- Context, StartString, Terminator)
+ Types, RetType, MaybeDet, Purity, ClassContext,
+ Context, AppendVarnums, StartString, Terminator)
).
mercury_output_func_type(VarSet, ExistQVars, FuncName, Types, RetType,
- MaybeDet, Purity, ClassContext, Context) -->
+ MaybeDet, Purity, ClassContext, Context, AppendVarnums) -->
mercury_output_func_type_2(VarSet, ExistQVars, FuncName, Types,
RetType, MaybeDet, Purity, ClassContext, Context,
- ":- ", ".\n").
+ AppendVarnums, ":- ", ".\n").
:- pred mercury_output_func_type_2(tvarset, existq_tvars, sym_name,
list(type), type, maybe(determinism), purity, class_constraints,
- prog_context, string, string, io__state, io__state).
+ prog_context, bool, string, string, io__state, io__state).
:- mode mercury_output_func_type_2(in, in, in, in, in, in, in, in, in, in, in,
- di, uo) is det.
+ in, di, uo) is det.
mercury_output_func_type_2(VarSet, ExistQVars, FuncName, Types, RetType,
- MaybeDet, Purity, ClassContext, _Context, StartString,
- Separator) -->
+ MaybeDet, Purity, ClassContext, _Context, AppendVarnums,
+ StartString, Separator) -->
io__write_string(StartString),
- mercury_output_quantifier(VarSet, ExistQVars),
+ mercury_output_quantifier(VarSet, AppendVarnums, ExistQVars),
( { ExistQVars = [], ClassContext = constraints(_, []) } ->
[]
;
@@ -1455,57 +1482,63 @@
->
mercury_output_sym_name(FuncName),
io__write_string("("),
- mercury_output_term(Type, VarSet, no),
- mercury_output_remaining_terms(Rest, VarSet, no),
+ mercury_output_term(Type, VarSet, AppendVarnums),
+ mercury_output_remaining_terms(Rest, VarSet, AppendVarnums),
io__write_string(")")
;
mercury_output_bracketed_sym_name(FuncName)
),
io__write_string(" = "),
- mercury_output_term(RetType, VarSet, no, next_to_graphic_token),
- mercury_output_class_context(ClassContext, ExistQVars, VarSet),
+ mercury_output_term(RetType, VarSet, AppendVarnums,
+ next_to_graphic_token),
+ mercury_output_class_context(ClassContext, ExistQVars, VarSet,
+ AppendVarnums),
mercury_output_det_annotation(MaybeDet),
io__write_string(Separator).
%-----------------------------------------------------------------------------%
-mercury_output_quantifier(VarSet, ExistQVars) -->
+mercury_output_quantifier(VarSet, AppendVarNums, ExistQVars) -->
( { ExistQVars = [] } ->
[]
;
io__write_string("some ["),
- mercury_output_vars(ExistQVars, VarSet, no),
+ mercury_output_vars(ExistQVars, VarSet, AppendVarNums),
io__write_string("] ")
).
%-----------------------------------------------------------------------------%
:- pred mercury_output_class_context(class_constraints, existq_tvars, tvarset,
- io__state, io__state).
-:- mode mercury_output_class_context(in, in, in, di, uo) is det.
+ bool, io__state, io__state).
+:- mode mercury_output_class_context(in, in, in, in, di, uo) is det.
-mercury_output_class_context(ClassContext, ExistQVars, VarSet) -->
+mercury_output_class_context(ClassContext, ExistQVars, VarSet,
+ AppendVarnums) -->
{ ClassContext = constraints(UnivCs, ExistCs) },
- mercury_output_class_constraint_list(ExistCs, VarSet, "=>"),
+ mercury_output_class_constraint_list(ExistCs, VarSet, "=>",
+ AppendVarnums),
( { ExistQVars = [], ExistCs = [] } ->
[]
;
io__write_string(")")
),
- mercury_output_class_constraint_list(UnivCs, VarSet, "<=").
+ mercury_output_class_constraint_list(UnivCs, VarSet, "<=",
+ AppendVarnums).
:- pred mercury_output_class_constraint_list(list(class_constraint), tvarset,
- string, io__state, io__state).
-:- mode mercury_output_class_constraint_list(in, in, in, di, uo) is det.
+ string, bool, io__state, io__state).
+:- mode mercury_output_class_constraint_list(in, in, in, in, di, uo) is det.
-mercury_output_class_constraint_list(Constraints, VarSet, Operator) -->
+mercury_output_class_constraint_list(Constraints, VarSet, Operator,
+ AppendVarnums) -->
(
{ Constraints = [] }
;
{ Constraints = [_|_] },
io__write_strings([" ", Operator, " ("]),
io__write_list(Constraints, ", ",
- mercury_output_constraint(VarSet)),
+ mercury_output_constraint(VarSet, AppendVarnums)),
io__write_char(')')
).
@@ -1513,10 +1546,10 @@
% and io__write_string, but for efficiency's sake it's probably not
% worth doing as it would mean building an intermediate string every
% time you print a constraint. (eg. when generating interface files).
-mercury_output_constraint(VarSet, constraint(Name, Types)) -->
+mercury_output_constraint(VarSet, AppendVarnums, constraint(Name, Types)) -->
mercury_output_sym_name(Name),
io__write_char('('),
- io__write_list(Types, ", ", output_type(VarSet)),
+ io__write_list(Types, ", ", output_type(VarSet, AppendVarnums)),
io__write_char(')').
mercury_constraint_to_string(VarSet, constraint(Name, Types), String) :-
@@ -1574,11 +1607,11 @@
)
).
-:- pred output_type(tvarset, (type), io__state, io__state).
-:- mode output_type(in, in, di, uo) is det.
+:- pred output_type(tvarset, bool, (type), io__state, io__state).
+:- mode output_type(in, in, in, di, uo) is det.
-output_type(VarSet, Type) -->
- mercury_output_term(Type, VarSet, no).
+output_type(VarSet, AppendVarnums, Type) -->
+ mercury_output_term(Type, VarSet, AppendVarnums).
%-----------------------------------------------------------------------------%
Index: post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.26
diff -u -u -r1.26 post_typecheck.m
--- post_typecheck.m 2000/09/05 02:36:10 1.26
+++ post_typecheck.m 2000/09/05 13:48:02
@@ -291,7 +291,9 @@
prog_out__write_context(Context),
io__write_string(" "),
- io__write_list(Constraints, ", ", mercury_output_constraint(TVarSet)),
+ { AppendVarnums = no },
+ io__write_list(Constraints, ", ",
+ mercury_output_constraint(TVarSet, AppendVarnums)),
io__write_string(".\n").
%
Index: typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.280
diff -u -u -r1.280 typecheck.m
--- typecheck.m 2000/09/05 03:38:34 1.280
+++ typecheck.m 2000/09/05 13:48:04
@@ -3809,8 +3809,10 @@
UnprovenConstraints),
prog_out__write_context(Context, IO0, IO1),
io__write_string(" `", IO1, IO2),
+ AppendVarnums = no,
io__write_list(UnprovenConstraints, "', `",
- mercury_output_constraint(VarSet), IO2, IO3),
+ mercury_output_constraint(VarSet, AppendVarnums),
+ IO2, IO3),
io__write_string("'.\n", IO3, IO)
)),
@@ -4443,13 +4445,15 @@
{ MaybeDet = no },
prog_out__write_context(Context),
io__write_string("Inferred "),
+ { AppendVarNums = no },
( { PredOrFunc = predicate },
mercury_output_pred_type(VarSet, ExistQVars, Name, Types,
- MaybeDet, Purity, ClassContext, Context)
+ MaybeDet, Purity, ClassContext, Context, AppendVarNums)
; { PredOrFunc = function },
{ pred_args_to_func_args(Types, ArgTypes, RetType) },
mercury_output_func_type(VarSet, ExistQVars, Name, ArgTypes,
- RetType, MaybeDet, Purity, ClassContext, Context)
+ RetType, MaybeDet, Purity, ClassContext, Context,
+ AppendVarNums)
).
%-----------------------------------------------------------------------------%
@@ -5085,7 +5089,8 @@
),
{ apply_rec_subst_to_constraint(TypeBindings, Constraint,
BoundConstraint) },
- mercury_output_constraint(TypeVarSet, BoundConstraint),
+ { AppendVarNums = no },
+ mercury_output_constraint(TypeVarSet, AppendVarNums, BoundConstraint),
write_type_assign_constraints(Operator, Constraints,
TypeBindings, TypeVarSet, yes).
--------------------------------------------------------------------------
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