[m-rev.] for review: XML documentation of DU types pass
Peter Ross
pro at missioncriticalit.com
Tue Oct 31 15:59:31 AEDT 2006
Hi,
This is for juliensf to review.
This change isn't finished as it only documents discriminated union
types, but I would like to have this reviewed as the rest of the change
is just drudgery.
===================================================================
Estimated hours taken: 24
Branches: main
Generate an XML representation of the du types in the current module.
Notably we associate with each type, data constructor and data field
a comment, describing that part of the declaration.
The current strategy associates the comment starting on the same line
as the type declaration, and if there is none then the comment directly
above. At a later date, this strategy needs to be made more flexible.
This required two main changes to the compiler.
Change one was to associate with a term.variable the context
of that variable.
Then the constructor and constructor_arg types had to have their
context recorded.
compiler/xml_documentation.m:
Add the pass which generates an XML documentation
of the du types in the current module.
compiler/handle_options.m:
compiler/mercury_compile.m:
compiler/options.m:
Call the xml_documentation phase and stop afterwards.
library/term.m:
Add the term.context to term.variables.
Remove the backwards mode of var_list_to_term_list as it
no longer works.
Make the predicate version of term_list_to_var_list
semidet as we can no longer use the backwards version
var_list_to_term_list.
library/parser.m:
Fill in the term.context of term.variables while parsing.
compiler/prog_data.m:
Add the context to the constructor and constructor_arg types.
compiler/prog_io.m:
Fill in the context fields in the constructor and constructor_arg
types.
compiler/add_clause.m:
compiler/prog_io.m:
compiler/prog_io_typeclass.m:
compiler/typecheck.m:
Call the correct version of term_list_to_var_list,
to deal with the fact that we removed the reverse
mode of var_list_to_term_list.
compiler/add_clause.m:
compiler/det_util.m:
compiler/fact_table.m:
compiler/hlds_out.m:
compiler/inst_graph.m:
compiler/intermod.m:
compiler/make_hlds_passes.m:
compiler/mercury_to_mercury.m:
compiler/prog_ctgc.m:
compiler/prog_io.m:
compiler/prog_io_dcg.m:
compiler/prog_io_goal.m:
compiler/prog_io_pragma.m:
compiler/prog_io_typeclass.m:
compiler/prog_io_util.m:
compiler/prog_io_util.m:
compiler/prog_util.m:
compiler/state_var.m:
compiler/superhomogeneous.m:
compiler/switch_detection.m:
compiler/typecheck_errors.m:
library/term_io.m:
library/varset.m:
Handle the context in the term.variable structure.
compiler/add_type.m:
compiler/check_typeclass.m:
compiler/equiv_type.m:
compiler/hhf.m:
compiler/hlds_out.m:
compiler/inst_check.m:
compiler/make_tags.m:
compiler/mercury_to_mercury.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/mode_util.m:
compiler/module_qual.m:
compiler/post_typecheck.m:
compiler/prog_io.m:
compiler/prog_mode.m:
compiler/prog_type.m:
compiler/recompilation.check.m:
compiler/recompilation.usage.m:
compiler/special_pred.m:
compiler/term_constr_build.m:
compiler/term_norm.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/unify_proc.m:
compiler/untupling.m:
compiler/unused_imports.m:
Handle the context field in the constructor and constructor_arg
types.
compiler/check_hlds.m:
Add the xml_documentation module.
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.36
diff -u -r1.36 add_clause.m
--- compiler/add_clause.m 2 Oct 2006 05:21:07 -0000 1.36
+++ compiler/add_clause.m 31 Oct 2006 04:52:45 -0000
@@ -132,7 +132,7 @@
(
GoalType = goal_type_promise(_)
->
- term.term_list_to_var_list(Args, HeadVars),
+ HeadVars = term.term_list_to_var_list(Args),
preds_add_implicit_for_assertion(HeadVars, !.ModuleInfo,
ModuleName, PredName, Arity, Status, Context, PredOrFunc,
PredId, !PredicateTable),
@@ -868,11 +868,11 @@
NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
% It is an error for the left or right hand side of a
% unification to be !X (it may be !.X or !:X, however).
- ( A0 = functor(atom("!"), [variable(StateVarA)], _) ->
+ ( A0 = functor(atom("!"), [variable(StateVarA, _)], _) ->
report_svar_unify_error(Context, !.VarSet, StateVarA, !Specs),
Goal = true_goal,
NumAdded = 0
- ; B0 = functor(atom("!"), [variable(StateVarB)], _) ->
+ ; B0 = functor(atom("!"), [variable(StateVarB, _)], _) ->
report_svar_unify_error(Context, !.VarSet, StateVarB, !Specs),
Goal = true_goal,
NumAdded = 0
@@ -896,8 +896,8 @@
MutableHLDS = trace_mutable_var_hlds(MutableName, StateVarName),
GetPredName = unqualified("get_" ++ MutableName),
SetPredName = unqualified("set_" ++ MutableName),
- SetVar = functor(atom("!:"), [variable(StateVar)], Context),
- UseVar = functor(atom("!."), [variable(StateVar)], Context),
+ SetVar = functor(atom("!:"), [variable(StateVar, context_init)], Context),
+ UseVar = functor(atom("!."), [variable(StateVar, context_init)], Context),
GetPurity = purity_semipure,
SetPurity = purity_impure,
GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
@@ -910,8 +910,8 @@
Builtin = mercury_private_builtin_module,
GetPredName = qualified(Builtin, "trace_get_io_state"),
SetPredName = qualified(Builtin, "trace_set_io_state"),
- SetVar = functor(atom("!:"), [variable(StateVar)], Context),
- UseVar = functor(atom("!."), [variable(StateVar)], Context),
+ SetVar = functor(atom("!:"), [variable(StateVar, context_init)], Context),
+ UseVar = functor(atom("!."), [variable(StateVar, context_init)], Context),
GetPurity = purity_semipure,
SetPurity = purity_impure,
GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.21
diff -u -r1.21 add_type.m
--- compiler/add_type.m 2 Oct 2006 05:21:08 -0000 1.21
+++ compiler/add_type.m 31 Oct 2006 04:52:45 -0000
@@ -678,9 +678,9 @@
list(error_spec)::in, list(error_spec)::out) is det.
ctors_add([], _, _, _, _, _, _, !FieldNameTable, !Ctors, !Specs).
-ctors_add([Ctor | Rest], TypeCtor, TVarSet, NeedQual, PQInfo, Context,
+ctors_add([Ctor | Rest], TypeCtor, TVarSet, NeedQual, PQInfo, _Context,
ImportStatus, !FieldNameTable, !Ctors, !Specs) :-
- Ctor = ctor(ExistQVars, Constraints, Name, Args),
+ Ctor = ctor(ExistQVars, Constraints, Name, Args, Context),
QualifiedConsId = make_cons_id(Name, Args, TypeCtor),
ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Args, TypeCtor,
Context),
@@ -727,7 +727,8 @@
list.map_foldl(add_ctor(ConsName, Arity, ConsDefn),
PartialQuals, _PartiallyQualifiedConsIds, !Ctors),
- assoc_list.keys(Args, FieldNames),
+ FieldNames = list.map(func(C) = C ^ arg_field_name, Args),
+
FirstField = 1,
add_ctor_field_names(FieldNames, NeedQual, PartialQuals, TypeCtor,
Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.17
diff -u -r1.17 check_hlds.m
--- compiler/check_hlds.m 27 Sep 2006 06:16:48 -0000 1.17
+++ compiler/check_hlds.m 31 Oct 2006 04:52:45 -0000
@@ -79,6 +79,9 @@
% Warnings about unused imports
:- include_module unused_imports.
+% Output XML representation useful for documentation of module
+:- include_module xml_documentation.
+
:- include_module goal_path.
%-----------------------------------------------------------------------------%
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.106
diff -u -r1.106 check_typeclass.m
--- compiler/check_typeclass.m 29 Oct 2006 03:18:49 -0000 1.106
+++ compiler/check_typeclass.m 31 Oct 2006 04:52:45 -0000
@@ -1297,8 +1297,8 @@
list(error_spec)::in, list(error_spec)::out) is det.
check_ctor_type_ambiguities(TypeCtor, TypeDefn, Ctor, !ModuleInfo, !Specs) :-
- Ctor = ctor(ExistQVars, Constraints, _, CtorArgs),
- assoc_list.values(CtorArgs, ArgTypes),
+ Ctor = ctor(ExistQVars, Constraints, _, CtorArgs, _),
+ ArgTypes = list.map(func(ctor_arg(_, T, _)) = T, CtorArgs),
type_vars_list(ArgTypes, ArgTVars),
list.filter((pred(V::in) is semidet :- list.member(V, ExistQVars)),
ArgTVars, ExistQArgTVars),
Index: compiler/det_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_util.m,v
retrieving revision 1.42
diff -u -r1.42 det_util.m
--- compiler/det_util.m 13 Oct 2006 04:52:18 -0000 1.42
+++ compiler/det_util.m 31 Oct 2006 04:52:45 -0000
@@ -114,11 +114,11 @@
).
interpret_unify(X, rhs_var(Y), !Subst) :-
- unify_term(variable(X), variable(Y), !Subst).
+ unify_term(variable(X, context_init), variable(Y, context_init), !Subst).
interpret_unify(X, rhs_functor(ConsId, _, ArgVars), !Subst) :-
term.var_list_to_term_list(ArgVars, ArgTerms),
cons_id_and_args_to_term(ConsId, ArgTerms, RhsTerm),
- unify_term(variable(X), RhsTerm, !Subst).
+ unify_term(variable(X, context_init), RhsTerm, !Subst).
interpret_unify(_X, rhs_lambda_goal(_, _, _, _, _, _, _, _), !Subst).
% For ease of implementation we just ignore unifications with lambda terms.
% This is a safe approximation, it just prevents us from optimizing them
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.73
diff -u -r1.73 equiv_type.m
--- compiler/equiv_type.m 16 Oct 2006 01:55:07 -0000 1.73
+++ compiler/equiv_type.m 31 Oct 2006 04:52:45 -0000
@@ -667,8 +667,8 @@
used_modules::in, used_modules::out) is det.
replace_in_ctor(Location, EqvMap,
- ctor(ExistQVars, Constraints0, TName, Targs0),
- ctor(ExistQVars, Constraints, TName, Targs),
+ ctor(ExistQVars, Constraints0, TName, Targs0, Ctxt),
+ ctor(ExistQVars, Constraints, TName, Targs, Ctxt),
!VarSet, !Info, !UsedModules) :-
replace_in_ctor_arg_list(Location,
EqvMap, Targs0, Targs, _, !VarSet, !Info, !UsedModules),
@@ -751,8 +751,8 @@
replace_in_ctor_arg_list_2(_Location, _EqvMap, _Seen, [], [],
!Circ, !VarSet, !Info, !UsedModules).
-replace_in_ctor_arg_list_2(Location,
- EqvMap, Seen, [N - T0 | As0], [N - T | As],
+replace_in_ctor_arg_list_2(Location, EqvMap, Seen,
+ [ctor_arg(N, T0, C) | As0], [ctor_arg(N, T, C) | As],
!Circ, !VarSet, !Info, !UsedModules) :-
replace_in_type_location_2(Location, EqvMap, Seen, T0, T, _, ContainsCirc,
!VarSet, !Info, !UsedModules),
Index: compiler/fact_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/fact_table.m,v
retrieving revision 1.79
diff -u -r1.79 fact_table.m
--- compiler/fact_table.m 7 Sep 2006 05:50:53 -0000 1.79
+++ compiler/fact_table.m 31 Oct 2006 04:52:45 -0000
@@ -387,7 +387,7 @@
int::in, fact_result::out, error_reports::in, error_reports::out,
io::di, io::uo) is det.
-check_fact_term(_, _, _, _, term.variable(_V), _, _, _, _, error,
+check_fact_term(_, _, _, _, term.variable(_V, _), _, _, _, _, error,
!Errors, !IO) :-
io.get_line_number(LineNum, !IO),
io.input_stream_name(FileName, !IO),
@@ -489,7 +489,7 @@
Context0, Result, !Errors) :-
ArgNum = ArgNum0 + 1,
(
- Term = term.variable(_),
+ Term = term.variable(_, _),
Msg = "Error: non-ground term in fact.",
add_error_report(Context0, [words(Msg)], !Errors),
Result = error
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.276
diff -u -r1.276 handle_options.m
--- compiler/handle_options.m 5 Oct 2006 04:45:32 -0000 1.276
+++ compiler/handle_options.m 31 Oct 2006 04:52:45 -0000
@@ -128,6 +128,8 @@
MakeTransOptInt, !IO),
globals.io_lookup_bool_option(make_analysis_registry,
MakeAnalysisRegistry, !IO),
+ globals.io_lookup_bool_option(make_xml_documentation,
+ MakeXmlDocumentation, !IO),
globals.io_lookup_bool_option(convert_to_mercury,
ConvertToMercury, !IO),
globals.io_lookup_bool_option(typecheck_only, TypecheckOnly, !IO),
@@ -140,8 +142,8 @@
bool.or_list([GenerateDependencies, GenerateDependencyFile,
MakeInterface, MakePrivateInterface, MakeShortInterface,
MakeOptimizationInt, MakeTransOptInt, MakeAnalysisRegistry,
- ConvertToMercury, TypecheckOnly, ErrorcheckOnly, TargetCodeOnly,
- GenerateIL, CompileOnly],
+ MakeXmlDocumentation, ConvertToMercury, TypecheckOnly,
+ ErrorcheckOnly, TargetCodeOnly, GenerateIL, CompileOnly],
NotLink),
bool.not(NotLink, Link),
globals.io_lookup_bool_option(smart_recompilation, Smart, !IO),
Index: compiler/hhf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hhf.m,v
retrieving revision 1.25
diff -u -r1.25 hhf.m
--- compiler/hhf.m 22 Aug 2006 05:03:45 -0000 1.25
+++ compiler/hhf.m 31 Oct 2006 04:52:45 -0000
@@ -410,7 +410,7 @@
type_ctor::in, constructor::in, hhf_info::in, hhf_info::out) is det.
maybe_add_cons_id(Var, ModuleInfo, BaseVars, TypeId, Ctor, !HI) :-
- Ctor = ctor(_, _, Name, Args),
+ Ctor = ctor(_, _, Name, Args, _),
ConsId = make_cons_id(Name, Args, TypeId),
map.lookup(!.HI ^ inst_graph, Var, node(Functors0, MaybeParent)),
( map.contains(Functors0, ConsId) ->
@@ -429,7 +429,7 @@
is det.
add_cons_id(Var, ModuleInfo, BaseVars, Arg, NewVar, !HI) :-
- Arg = _ - ArgType,
+ ArgType = Arg ^ arg_type,
!.HI = hhf_info(InstGraph0, VarSet0, VarTypes0),
(
find_var_with_type(Var, ArgType, InstGraph0, VarTypes0,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.409
diff -u -r1.409 hlds_out.m
--- compiler/hlds_out.m 22 Oct 2006 09:14:24 -0000 1.409
+++ compiler/hlds_out.m 31 Oct 2006 04:52:45 -0000
@@ -1763,7 +1763,7 @@
),
term.context_init(Context),
Functor = term.atom("class_method_call"),
- TCInfoTerm = term.variable(TCInfoVar),
+ TCInfoTerm = term.variable(TCInfoVar, Context),
MethodNumTerm = term.functor(term.integer(MethodNum), [], Context),
term.var_list_to_term_list(ArgVars, ArgTerms),
Term = term.functor(Functor, [TCInfoTerm, MethodNumTerm | ArgTerms],
@@ -3321,7 +3321,7 @@
write_ctor(C, TVarSet, TagValues, !IO) :-
mercury_output_ctor(C, TVarSet, !IO),
- C = ctor(_, _, Name, Args),
+ C = ctor(_, _, Name, Args, _),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
( map.search(TagValues, ConsId, TagValue) ->
io.write_string("\t% tag: ", !IO),
@@ -3980,11 +3980,11 @@
Term = make_atom(inst_uniqueness(Uniq, "ground"), Context)
).
inst_to_term_with_context(inst_var(Var), _) =
- term.coerce(term.variable(Var)).
+ term.coerce(term.variable(Var, context_init)).
inst_to_term_with_context(constrained_inst_vars(Vars, Inst), Context) =
set.fold(func(Var, Term) =
term.functor(term.atom("=<"),
- [term.coerce(term.variable(Var)), Term], Context),
+ [term.coerce(term.variable(Var, context_init)), Term], Context),
Vars, inst_to_term_with_context(Inst, Context)).
inst_to_term_with_context(abstract_inst(Name, Args), Context) =
inst_name_to_term(user_inst(Name, Args), Context).
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.5
diff -u -r1.5 inst_check.m
--- compiler/inst_check.m 27 Sep 2006 06:16:52 -0000 1.5
+++ compiler/inst_check.m 31 Oct 2006 04:52:45 -0000
@@ -304,7 +304,7 @@
:- func constructor_to_sym_name_and_arity(constructor) = sym_name_and_arity.
-constructor_to_sym_name_and_arity(ctor(_, _, Name, Args)) =
+constructor_to_sym_name_and_arity(ctor(_, _, Name, Args, _)) =
Name / list.length(Args).
% multi_map_set is the same as multi_map.set, except that the arguments are
Index: compiler/inst_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_graph.m,v
retrieving revision 1.11
diff -u -r1.11 inst_graph.m
--- compiler/inst_graph.m 31 Jul 2006 08:31:42 -0000 1.11
+++ compiler/inst_graph.m 31 Oct 2006 04:52:45 -0000
@@ -362,7 +362,7 @@
merge(InstGraph0, VarSet0, NewInstGraph, NewVarSet, InstGraph, VarSet, Sub) :-
varset.merge_subst_without_names(VarSet0, NewVarSet, VarSet, Sub0),
(
- map.map_values(pred(_::in, term.variable(V)::in, V::out) is semidet,
+ map.map_values(pred(_::in, term.variable(V, _)::in, V::out) is semidet,
Sub0, Sub1)
->
Sub = Sub1
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.211
diff -u -r1.211 intermod.m
--- compiler/intermod.m 13 Oct 2006 04:52:19 -0000 1.211
+++ compiler/intermod.m 31 Oct 2006 04:52:45 -0000
@@ -1672,7 +1672,7 @@
( map.search(HeadVarMap, HeadVar0, HeadTerm0) ->
HeadTerm = HeadTerm0
;
- HeadTerm = term.variable(HeadVar0)
+ HeadTerm = term.variable(HeadVar0, Context)
)
), HeadVars, HeadTerms),
conj_list_to_goal(Goals, GoalInfo0, Goal)
@@ -1694,12 +1694,12 @@
(
Goal = unify(LHSVar, RHS, _, _, _) - _,
list.member(LHSVar, HeadVars),
+ term.context_init(Context),
(
RHS = rhs_var(RHSVar),
- RHSTerm = term.variable(RHSVar)
+ RHSTerm = term.variable(RHSVar, Context)
;
RHS = rhs_functor(ConsId, _, Args),
- term.context_init(Context),
(
ConsId = int_const(Int),
RHSTerm = term.functor(term.integer(Int), [], Context)
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.58
diff -u -r1.58 make_hlds_passes.m
--- compiler/make_hlds_passes.m 13 Oct 2006 04:52:20 -0000 1.58
+++ compiler/make_hlds_passes.m 31 Oct 2006 04:52:45 -0000
@@ -1586,7 +1586,7 @@
% Construct the semipure get predicate.
%
UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName, Name),
- UnsafeGetCallArgs = [variable(X)],
+ UnsafeGetCallArgs = [variable(X, context_init)],
CallUnsafeGet = call_expr(UnsafeGetPredName, UnsafeGetCallArgs,
purity_semipure) - Context,
@@ -1600,7 +1600,7 @@
ProgVarSet0,
predicate,
GetPredName,
- [variable(X)],
+ [variable(X, context_init)],
StdGetBody
),
@@ -1610,7 +1610,7 @@
% Construct the impure set predicate.
%
UnsafeSetPredName = mutable_unsafe_set_pred_sym_name(ModuleName, Name),
- UnsafeSetCallArgs = [variable(X)],
+ UnsafeSetCallArgs = [variable(X, context_init)],
StdSetCallUnsafeSet = call_expr(UnsafeSetPredName, UnsafeSetCallArgs,
purity_impure) - Context,
@@ -1622,7 +1622,7 @@
ProgVarSet0,
predicate,
SetPredName,
- [variable(X)],
+ [variable(X, context_init)],
StdSetBody
),
@@ -1639,12 +1639,13 @@
IOGetBody = promise_purity_expr(dont_make_implicit_promises,
purity_pure, GetBody) - Context,
+ Ctxt = context_init,
IOGetClause = item_clause(
compiler(mutable_decl),
ProgVarSet,
predicate,
GetPredName,
- [variable(X), variable(IO), variable(IO)],
+ [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
IOGetBody
),
@@ -1664,7 +1665,7 @@
ProgVarSet,
predicate,
SetPredName,
- [variable(X), variable(IO), variable(IO)],
+ [variable(X, Ctxt), variable(IO, Ctxt), variable(IO, Ctxt)],
IOSetBody
),
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.55
diff -u -r1.55 make_tags.m
--- compiler/make_tags.m 20 Aug 2006 08:21:15 -0000 1.55
+++ compiler/make_tags.m 31 Oct 2006 04:52:45 -0000
@@ -195,7 +195,7 @@
assign_enum_constants([], _, !CtorTags).
assign_enum_constants([Ctor | Rest], Val, !CtorTags) :-
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
Tag = int_tag(Val),
svmap.set(ConsId, Tag, !CtorTags),
@@ -215,7 +215,7 @@
( Address >= NumReservedAddresses ->
LeftOverConstants = [Ctor | Rest]
;
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
( Address = 0 ->
Tag = reserved_address_tag(null_pointer)
@@ -240,7 +240,7 @@
( Num >= Max ->
LeftOverConstants = [Ctor | Ctors]
;
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
Arity = list.length(Args),
Tag = reserved_address_tag(reserved_object(TypeCtor, Name, Arity)),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
@@ -278,7 +278,7 @@
assign_unshared_tags([], _, _, _, !CtorTags).
assign_unshared_tags([Ctor | Rest], Val, MaxTag, ReservedAddresses,
!CtorTags) :-
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
% If there's only one functor,
% give it the "single_functor" (untagged)
@@ -313,7 +313,7 @@
assign_shared_remote_tags([], _, _, _, !CtorTags).
assign_shared_remote_tags([Ctor | Rest], PrimaryVal, SecondaryVal,
ReservedAddresses, !CtorTags) :-
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
Tag = maybe_add_reserved_addresses(ReservedAddresses,
shared_remote_tag(PrimaryVal, SecondaryVal)),
@@ -327,7 +327,7 @@
assign_shared_local_tags([], _, _, !CtorTags).
assign_shared_local_tags([Ctor | Rest], PrimaryVal, SecondaryVal, !CtorTags) :-
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
Tag = shared_local_tag(PrimaryVal, SecondaryVal),
svmap.set(ConsId, Tag, !CtorTags),
@@ -359,7 +359,7 @@
ctors_are_all_constants([]).
ctors_are_all_constants([Ctor | Rest]) :-
- Ctor = ctor(_ExistQVars, _Constraints, _Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, _Name, Args, _Ctxt),
Args = [],
ctors_are_all_constants(Rest).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.412
diff -u -r1.412 mercury_compile.m
--- compiler/mercury_compile.m 25 Oct 2006 03:39:04 -0000 1.412
+++ compiler/mercury_compile.m 31 Oct 2006 04:52:45 -0000
@@ -139,6 +139,7 @@
:- import_module check_hlds.goal_path.
:- import_module check_hlds.inst_check.
:- import_module check_hlds.unused_imports.
+:- import_module check_hlds.xml_documentation.
:- import_module hlds.arg_info.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
@@ -1461,6 +1462,8 @@
MakeTransOptInt, !IO),
globals.io_lookup_bool_option(make_analysis_registry,
MakeAnalysisRegistry, !IO),
+ globals.io_lookup_bool_option(make_xml_documentation,
+ MakeXmlDocumentation, !IO),
( TypeCheckOnly = yes ->
FactTableObjFiles = []
; ErrorCheckOnly = yes ->
@@ -1484,6 +1487,9 @@
; MakeAnalysisRegistry = yes ->
output_analysis_file(ModuleName, HLDS21, !DumpInfo, !IO),
FactTableObjFiles = []
+ ; MakeXmlDocumentation = yes ->
+ xml_documentation(HLDS21, !IO),
+ FactTableObjFiles = []
;
mercury_compile_after_front_end(NestedSubModules,
FindTimestampFiles, MaybeTimestamps, ModuleName, HLDS21,
@@ -2092,8 +2098,8 @@
MakeOptInt = no,
% Now go ahead and do the rest of mode checking
% and determinism analysis.
- frontend_pass_by_phases(!HLDS, FoundModeOrDetError, !DumpInfo,
- !IO),
+ frontend_pass_by_phases(!HLDS,
+ FoundModeOrDetError, !DumpInfo, !IO),
!:FoundError = !.FoundError `or` FoundModeOrDetError
)
)
@@ -3508,6 +3514,7 @@
WarnUnusedImports = no,
Specs = []
).
+
:- pred maybe_type_ctor_infos(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.306
diff -u -r1.306 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 13 Oct 2006 04:52:21 -0000 1.306
+++ compiler/mercury_to_mercury.m 31 Oct 2006 04:52:46 -0000
@@ -1066,13 +1066,13 @@
mercury_output_inst_defn(VarSet, Name, Args, abstract_inst, Context, !IO) :-
io.write_string(":- inst (", !IO),
- list.map(pred(V::in, variable(V)::out) is det, Args, ArgTerms),
+ ArgTerms = list.map(func(V) = variable(V, Context), Args),
construct_qualified_term(Name, ArgTerms, Context, InstTerm),
mercury_output_term(InstTerm, VarSet, no, !IO),
io.write_string(").\n", !IO).
mercury_output_inst_defn(VarSet, Name, Args, eqv_inst(Body), Context, !IO) :-
io.write_string(":- inst (", !IO),
- list.map(pred(V::in, variable(V)::out) is det, Args, ArgTerms),
+ ArgTerms = list.map(func(V) = variable(V, Context), Args),
construct_qualified_term(Name, ArgTerms, Context, InstTerm),
mercury_output_term(InstTerm, VarSet, no, !IO),
io.write_string(") == ", !IO),
@@ -1648,7 +1648,7 @@
mercury_format_mode_defn(VarSet, Name, Args, eqv_mode(Mode), Context, !U) :-
add_string(":- mode (", !U),
- list.map(pred(V::in, variable(V)::out) is det, Args, ArgTerms),
+ ArgTerms = list.map(func(V) = variable(V, Context), Args),
construct_qualified_term(Name, ArgTerms, Context, ModeTerm),
mercury_format_term(ModeTerm, VarSet, no, !U),
add_string(") == ", !U),
@@ -1720,7 +1720,7 @@
mercury_output_type_defn(TVarSet, Name, TParams,
parse_tree_abstract_type(IsSolverType), Context, !IO) :-
mercury_output_begin_type_decl(IsSolverType, !IO),
- Args = list.map((func(V) = term.variable(V)), TParams),
+ Args = list.map((func(V) = term.variable(V, Context)), TParams),
construct_qualified_term(Name, Args, Context, TypeTerm),
mercury_output_term(TypeTerm, TVarSet, no, next_to_graphic_token, !IO),
io.write_string(".\n", !IO).
@@ -1728,7 +1728,7 @@
mercury_output_type_defn(TVarSet, Name, TParams, parse_tree_eqv_type(Body),
Context, !IO) :-
mercury_output_begin_type_decl(non_solver_type, !IO),
- Args = list.map((func(V) = term.variable(V)), TParams),
+ Args = list.map((func(V) = term.variable(V, Context)), TParams),
construct_qualified_term(Name, Args, Context, TypeTerm),
mercury_output_term(TypeTerm, TVarSet, no, !IO),
io.write_string(" == ", !IO),
@@ -1738,7 +1738,7 @@
mercury_output_type_defn(TVarSet, Name, TParams,
parse_tree_du_type(Ctors, MaybeUserEqComp), Context, !IO) :-
mercury_output_begin_type_decl(non_solver_type, !IO),
- Args = list.map((func(V) = term.variable(V)), TParams),
+ Args = list.map((func(V) = term.variable(V, Context)), TParams),
construct_qualified_term(Name, Args, Context, TypeTerm),
mercury_output_term(TypeTerm, TVarSet, no, !IO),
io.write_string("\n\t--->\t", !IO),
@@ -1750,7 +1750,7 @@
parse_tree_solver_type(SolverTypeDetails, MaybeUserEqComp),
Context, !IO) :-
mercury_output_begin_type_decl(solver_type, !IO),
- Args = list.map((func(V) = term.variable(V)), TParams),
+ Args = list.map((func(V) = term.variable(V, Context)), TParams),
construct_qualified_term(Name, Args, Context, TypeTerm),
mercury_output_term(TypeTerm, TVarSet, no, !IO),
mercury_output_where_attributes(TVarSet, yes(SolverTypeDetails),
@@ -1771,7 +1771,7 @@
ForeignType = java(_),
io.write_string("java, ", !IO)
),
- Args = list.map((func(V) = term.variable(V)), TParams),
+ Args = list.map((func(V) = term.variable(V, context_init)), TParams),
construct_qualified_term(Name, Args, MercuryType),
mercury_output_term(MercuryType, TVarSet, no, !IO),
io.write_string(", \"", !IO),
@@ -1930,7 +1930,7 @@
mercury_output_ctors(Ctors, VarSet, !IO).
mercury_output_ctor(Ctor, VarSet, !IO) :-
- Ctor = ctor(ExistQVars, Constraints, SymName, Args),
+ Ctor = ctor(ExistQVars, Constraints, SymName, Args, _Ctxt),
% We'll have attached the module name to the type definition,
% so there's no point adding it to the constructor as well.
@@ -1994,15 +1994,14 @@
:- pred mercury_output_ctor_arg(tvarset::in, constructor_arg::in,
io::di, io::uo) is det.
-mercury_output_ctor_arg(Varset, N - T, !IO) :-
+mercury_output_ctor_arg(Varset, ctor_arg(N, T, _), !IO) :-
mercury_output_ctor_arg_name_prefix(N, !IO),
mercury_output_type(Varset, no, T, !IO).
mercury_output_remaining_ctor_args(_Varset, [], !IO).
-mercury_output_remaining_ctor_args(Varset, [N - T | As], !IO) :-
+mercury_output_remaining_ctor_args(Varset, [A | As], !IO) :-
io.write_string(", ", !IO),
- mercury_output_ctor_arg_name_prefix(N, !IO),
- mercury_output_type(Varset, no, T, !IO),
+ mercury_output_ctor_arg(Varset, A, !IO),
mercury_output_remaining_ctor_args(Varset, As, !IO).
:- pred mercury_output_ctor_arg_name_prefix(maybe(ctor_field_name)::in,
@@ -3694,7 +3693,7 @@
:- pred mercury_format_term(term(T)::in, varset(T)::in, bool::in,
needs_quotes::in, U::di, U::uo) is det <= output(U).
-mercury_format_term(term.variable(Var), VarSet, AppendVarnums, _, !U) :-
+mercury_format_term(term.variable(Var, _), VarSet, AppendVarnums, _, !U) :-
mercury_format_var(VarSet, AppendVarnums, Var, !U).
mercury_format_term(term.functor(Functor, Args, _), VarSet, AppendVarnums,
NextToGraphicToken, !U) :-
@@ -4289,7 +4288,7 @@
:- pred builtin_inst_name(sym_name::in, list(inst_var)::in) is semidet.
builtin_inst_name(unqualified(Name), Args0) :-
- Args1 = list.map(func(V) = term.variable(term.coerce_var(V)), Args0),
+ Args1 = list.map(func(V) = variable(coerce_var(V), context_init), Args0),
Term = term.functor(term.atom(Name), Args1, term.context_init),
convert_inst(no_allow_constrained_inst_var, Term, Inst),
Inst \= defined_inst(user_inst(_, _)).
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.60
diff -u -r1.60 ml_type_gen.m
--- compiler/ml_type_gen.m 2 Oct 2006 05:21:15 -0000 1.60
+++ compiler/ml_type_gen.m 31 Oct 2006 04:52:46 -0000
@@ -235,7 +235,7 @@
ml_gen_enum_constant(Context, ConsTagValues, Ctor) = MLDS_Defn :-
% Figure out the value of this enumeration constant.
- Ctor = ctor(_ExistQTVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQTVars, _Constraints, Name, Args, _Ctxt),
list.length(Args, Arity),
map.lookup(ConsTagValues, cons(Name, Arity), TagVal),
( TagVal = int_tag(Int) ->
@@ -449,7 +449,7 @@
% we don't do the same thing for primary tags, so this is most useful
% in the `--tags none' case, where there will be no primary tags.
- Ctor = ctor(_ExistQTVars, _Constraints, Name, _Args),
+ Ctor = ctor(_ExistQTVars, _Constraints, Name, _Args, _Ctxt),
UnqualifiedName = unqualify_name(Name),
ConstValue = const(mlconst_int(SecondaryTag)),
MLDS_Defn = mlds_defn(
@@ -507,7 +507,7 @@
:- func get_tagval(cons_tag_values, constructor) = cons_tag.
get_tagval(ConsTagValues, Ctor) = TagVal :-
- Ctor = ctor(_ExistQTVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQTVars, _Constraints, Name, Args, _Ctxt),
list.length(Args, Arity),
map.lookup(ConsTagValues, cons(Name, Arity), TagVal).
@@ -566,7 +566,7 @@
ml_gen_du_ctor_member(ModuleInfo, BaseClassId, BaseClassQualifier,
SecondaryTagClassId, TypeDefn, ConsTagValues, Ctor,
MLDS_Members0, MLDS_Members, MLDS_CtorMethods0, MLDS_CtorMethods) :-
- Ctor = ctor(ExistQTVars, Constraints, CtorName, Args),
+ Ctor = ctor(ExistQTVars, Constraints, CtorName, Args, _Ctxt),
% XXX We should keep a context for the constructor,
% but we don't, so we just use the context from the type.
@@ -888,10 +888,9 @@
:- pred ml_gen_du_ctor_field(module_info::in, prog_context::in,
constructor_arg::in, mlds_defn::out, int::in, int::out) is det.
-ml_gen_du_ctor_field(ModuleInfo, Context, MaybeFieldName - Type, MLDS_Defn,
- ArgNum0, ArgNum) :-
- ml_gen_field(ModuleInfo, Context, MaybeFieldName, Type, MLDS_Defn,
- ArgNum0, ArgNum).
+ml_gen_du_ctor_field(ModuleInfo, Context, Arg, MLDS_Defn, ArgNum0, ArgNum) :-
+ ml_gen_field(ModuleInfo, Context, Arg ^ arg_field_name, Arg ^ arg_type,
+ MLDS_Defn, ArgNum0, ArgNum).
:- pred ml_gen_field(module_info::in, prog_context::in,
maybe(ctor_field_name)::in, mer_type::in, mlds_defn::out,
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.107
diff -u -r1.107 ml_unify_gen.m
--- compiler/ml_unify_gen.m 7 Sep 2006 05:50:59 -0000 1.107
+++ compiler/ml_unify_gen.m 31 Oct 2006 04:52:46 -0000
@@ -968,7 +968,7 @@
type_util.get_cons_defn(ModuleInfo, TypeCtor, CtorId, ConsDefn)
->
ConsDefn = hlds_cons_defn(_, _, ConsArgDefns, _, _),
- assoc_list.values(ConsArgDefns, ConsArgTypes0),
+ ConsArgTypes0 = list.map(func(C) = C ^ arg_type, ConsArgDefns),
% There may have been additional types inserted to hold the
% type_infos and type_class_infos for existentially quantified
@@ -1426,7 +1426,8 @@
ml_field_names_and_types(Info, Type, ConsId, ArgTypes, Fields) :-
% Lookup the field types for the arguments of this cons_id.
- MakeUnnamedField = (func(FieldType) = no - FieldType),
+ Context = term.context_init,
+ MakeUnnamedField = (func(FieldType) = ctor_arg(no, FieldType, Context)),
(
type_is_tuple(Type, _),
list.length(ArgTypes, TupleArity)
@@ -1493,7 +1494,8 @@
ml_gen_unify_arg(ConsId, Arg, Mode, ArgType, Field, VarType, VarLval,
Offset, ArgNum, Tag, Context, !Statements, !Info) :-
- Field = MaybeFieldName - FieldType,
+ MaybeFieldName = Field ^ arg_field_name,
+ FieldType = Field ^ arg_type,
ml_gen_info_get_module_info(!.Info, ModuleInfo),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.193
diff -u -r1.193 mode_util.m
--- compiler/mode_util.m 27 Sep 2006 06:16:56 -0000 1.193
+++ compiler/mode_util.m 31 Oct 2006 04:52:46 -0000
@@ -763,7 +763,7 @@
constructors_to_bound_insts_2(_, _, [], _, []).
constructors_to_bound_insts_2(ModuleInfo, Uniq, [Ctor | Ctors], ArgInst,
[BoundInst | BoundInsts]) :-
- Ctor = ctor(_ExistQVars, _Constraints, Name, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, Name, Args, _Ctxt),
ctor_arg_list_to_inst_list(Args, ArgInst, Insts),
list.length(Insts, Arity),
BoundInst = bound_functor(cons(Name, Arity), Insts),
@@ -774,7 +774,7 @@
list(mer_inst)::out) is det.
ctor_arg_list_to_inst_list([], _, []).
-ctor_arg_list_to_inst_list([_Name - _Type | Args], Inst, [Inst | Insts]) :-
+ctor_arg_list_to_inst_list([_ | Args], Inst, [Inst | Insts]) :-
ctor_arg_list_to_inst_list(Args, Inst, Insts).
:- pred propagate_ctor_info_2(module_info::in, mer_type::in,
@@ -844,14 +844,14 @@
(
ConsId = cons(ConsName, Arity),
GetCons = (pred(Ctor::in) is semidet :-
- Ctor = ctor(_, _, ConsName, CtorArgs),
+ Ctor = ctor(_, _, ConsName, CtorArgs, _),
list.length(CtorArgs, Arity)
),
list.filter(GetCons, Constructors, [Constructor])
->
- Constructor = ctor(_ExistQVars, _Constraints, _Name, Args),
+ Constructor = ctor(_ExistQVars, _Constraints, _Name, Args, _Ctxt),
GetArgTypes = (pred(CtorArg::in, ArgType::out) is det :-
- CtorArg = _ArgName - ArgType
+ ArgType = CtorArg ^ arg_type
),
list.map(GetArgTypes, Args, ArgTypes),
propagate_types_into_inst_list(ModuleInfo, Subst, ArgTypes,
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.150
diff -u -r1.150 module_qual.m
--- compiler/module_qual.m 13 Oct 2006 04:52:22 -0000 1.150
+++ compiler/module_qual.m 31 Oct 2006 04:52:46 -0000
@@ -825,11 +825,11 @@
qualify_constructors([], [], !Info, !Specs).
qualify_constructors([Ctor0 | Ctors0], [Ctor | Ctors], !Info, !Specs) :-
- Ctor0 = ctor(ExistQVars, Constraints0, SymName, Args0),
+ Ctor0 = ctor(ExistQVars, Constraints0, SymName, Args0, Ctxt),
qualify_constructor_arg_list(Args0, Args, !Info, !Specs),
qualify_constructors(Ctors0, Ctors, !Info, !Specs),
qualify_prog_constraint_list(Constraints0, Constraints, !Info, !Specs),
- Ctor = ctor(ExistQVars, Constraints, SymName, Args).
+ Ctor = ctor(ExistQVars, Constraints, SymName, Args, Ctxt).
% Qualify the inst parameters of an inst definition.
%
@@ -1006,9 +1006,9 @@
list(error_spec)::in, list(error_spec)::out) is det.
qualify_constructor_arg_list([], [], !Info, !Specs).
-qualify_constructor_arg_list([Name - Type0 | Args0], [Name - Type | Args],
- !Info, !Specs) :-
- qualify_type(Type0, Type, !Info, !Specs),
+qualify_constructor_arg_list([Arg0 | Args0], [Arg | Args], !Info, !Specs) :-
+ qualify_type(Arg0 ^ arg_type, Type, !Info, !Specs),
+ Arg = Arg0 ^ arg_type := Type,
qualify_constructor_arg_list(Args0, Args, !Info, !Specs).
:- pred qualify_type_list(list(mer_type)::in, list(mer_type)::out,
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.532
diff -u -r1.532 options.m
--- compiler/options.m 5 Oct 2006 04:59:21 -0000 1.532
+++ compiler/options.m 31 Oct 2006 04:52:46 -0000
@@ -164,6 +164,7 @@
; make_optimization_interface
; make_transitive_opt_interface
; make_analysis_registry
+ ; make_xml_documentation
; generate_source_file_mapping
; generate_dependency_file
; generate_dependencies
@@ -934,6 +935,7 @@
make_optimization_interface - bool(no),
make_transitive_opt_interface - bool(no),
make_analysis_registry - bool(no),
+ make_xml_documentation - bool(no),
convert_to_mercury - bool(no),
typecheck_only - bool(no),
errorcheck_only - bool(no),
@@ -1556,6 +1558,7 @@
short_option('v', verbose).
short_option('V', very_verbose).
short_option('w', inhibit_warnings).
+short_option('x', make_xml_documentation).
short_option('?', help).
% warning options
@@ -1657,6 +1660,7 @@
make_transitive_opt_interface).
long_option("make-trans-opt", make_transitive_opt_interface).
long_option("make-analysis-registry", make_analysis_registry).
+long_option("make-xml-documentation", make_xml_documentation).
long_option("convert-to-mercury", convert_to_mercury).
long_option("convert-to-Mercury", convert_to_mercury).
long_option("pretty-print", convert_to_mercury).
@@ -3048,6 +3052,10 @@
"--make-transitive-optimization-interface",
"\tOutput transitive optimization information",
"\tinto the `<module>.trans_opt' file.",
+ "\tThis option should only be used by mmake.",
+ "-x,--make-xml-documentation",
+ "\tOutput XML documentation of the module",
+ "\tinto the `<module>.xml' file.",
"\tThis option should only be used by mmake.",
"-P, --convert-to-mercury",
"\tConvert to Mercury. Output to file `<module>.ugly'",
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.110
diff -u -r1.110 post_typecheck.m
--- compiler/post_typecheck.m 27 Sep 2006 06:17:01 -0000 1.110
+++ compiler/post_typecheck.m 31 Oct 2006 04:52:46 -0000
@@ -1041,7 +1041,7 @@
hlds_data.get_type_defn_tvarset(TypeDefn, TypeTVarSet),
hlds_data.get_type_defn_kind_map(TypeDefn, TypeKindMap),
- assoc_list.values(ConsArgs, ConsArgTypes),
+ ConsArgTypes = list.map(func(C) = C ^ arg_type, ConsArgs),
arg_type_list_subsumes(TVarSet, ArgTypes, TypeTVarSet, TypeKindMap,
ConsExistQVars, ConsArgTypes).
@@ -1207,7 +1207,7 @@
type_util.get_type_and_cons_defn(ModuleInfo, TermType, ConsId,
TypeDefn, ConsDefn),
ConsDefn = hlds_cons_defn(ConsExistQVars, ConsConstraints, ConsArgs, _, _),
- assoc_list.values(ConsArgs, ConsArgTypes),
+ ConsArgTypes = list.map(func(C) = C ^ arg_type, ConsArgs),
(
ConsExistQVars = [],
@@ -1338,7 +1338,7 @@
"get_constructor_containing_field: can't find field").
get_constructor_containing_field_2([Ctor | Ctors], FieldName,
ConsId, FieldNumber) :-
- Ctor = ctor(_, _, SymName, CtorArgs),
+ Ctor = ctor(_, _, SymName, CtorArgs, _Ctxt),
(
get_constructor_containing_field_3(CtorArgs,
FieldName, 1, FieldNumber0)
@@ -1354,10 +1354,10 @@
:- pred get_constructor_containing_field_3(list(constructor_arg)::in,
ctor_field_name::in, int::in, int::out) is semidet.
-get_constructor_containing_field_3([MaybeArgFieldName - _ | CtorArgs],
+get_constructor_containing_field_3([CtorArg | CtorArgs],
FieldName, FieldNumber0, FieldNumber) :-
(
- MaybeArgFieldName = yes(ArgFieldName),
+ CtorArg ^ arg_field_name = yes(ArgFieldName),
UnqualFieldName = unqualify_name(ArgFieldName),
UnqualFieldName = unqualify_name(FieldName)
->
Index: compiler/prog_ctgc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_ctgc.m,v
retrieving revision 1.13
diff -u -r1.13 prog_ctgc.m
--- compiler/prog_ctgc.m 20 Aug 2006 08:21:24 -0000 1.13
+++ compiler/prog_ctgc.m 31 Oct 2006 04:52:46 -0000
@@ -279,7 +279,7 @@
Term = term.functor(term.atom(Cons), Args, _),
Cons = "cel",
Args = [VarTerm, SelectorTerm],
- VarTerm = term.variable(Var)
+ VarTerm = term.variable(Var, _)
->
Datastruct = selected_cel(term.coerce_var(Var),
parse_selector(SelectorTerm))
@@ -504,7 +504,7 @@
parse_user_annotated_datastruct_term(Term, Datastruct) :-
Term = term.functor(term.atom("cel"), [VarTerm, TypesTerm], _),
- VarTerm = term.variable(GenericVar),
+ VarTerm = term.variable(GenericVar, _),
term.coerce_var(GenericVar, ProgVar),
get_list_term_arguments(TypesTerm, TypeTermsList),
parse_types(TypeTermsList, ok1(Types)),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.177
diff -u -r1.177 prog_data.m
--- compiler/prog_data.m 13 Oct 2006 04:52:24 -0000 1.177
+++ compiler/prog_data.m 31 Oct 2006 04:52:46 -0000
@@ -1056,10 +1056,16 @@
cons_constraints :: list(prog_constraint),
% existential constraints
cons_name :: sym_name,
- cons_args :: list(constructor_arg)
+ cons_args :: list(constructor_arg),
+ cons_context :: prog_context
).
-:- type constructor_arg == pair(maybe(ctor_field_name), mer_type).
+:- type constructor_arg
+ ---> ctor_arg(
+ arg_field_name :: maybe(ctor_field_name),
+ arg_type :: mer_type,
+ arg_context :: prog_context
+ ).
:- type ctor_field_name == sym_name.
@@ -1949,7 +1955,7 @@
:- pred convert_subst_term_to_tvar(tvar::in, term(tvar_type)::in, tvar::out)
is det.
-convert_subst_term_to_tvar(_, variable(TVar), TVar).
+convert_subst_term_to_tvar(_, variable(TVar, _), TVar).
convert_subst_term_to_tvar(_, functor(_, _, _), _) :-
unexpected(this_file, "non-variable found in renaming").
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.276
diff -u -r1.276 prog_io.m
--- compiler/prog_io.m 2 Oct 2006 05:21:21 -0000 1.276
+++ compiler/prog_io.m 31 Oct 2006 04:52:46 -0000
@@ -2567,8 +2567,8 @@
% existentially quantified or occur in the head.
list.member(Ctor, Ctors),
- Ctor = ctor(ExistQVars, _Constraints, _CtorName, CtorArgs),
- assoc_list.values(CtorArgs, CtorArgTypes),
+ Ctor = ctor(ExistQVars, _Constraints, _CtorName, CtorArgs, _Ctxt),
+ CtorArgTypes = list.map(func(C) = C ^ arg_type, CtorArgs),
type_list_contains_var(CtorArgTypes, Var),
\+ list.member(Var, ExistQVars),
\+ list.member(Var, Params)
@@ -2581,7 +2581,7 @@
% If we were to allow it, we would need to rename them apart.)
list.member(Ctor, Ctors),
- Ctor = ctor(ExistQVars, _Constraints, _CtorName, _CtorArgs),
+ Ctor = ctor(ExistQVars, _Constraints, _CtorName, _CtorArgs, _Ctxt),
list.member(Var, ExistQVars),
list.member(Var, Params)
->
@@ -2593,9 +2593,9 @@
% somewhere in the constructor argument types or constraints.
list.member(Ctor, Ctors),
- Ctor = ctor(ExistQVars, Constraints, _CtorName, CtorArgs),
+ Ctor = ctor(ExistQVars, Constraints, _CtorName, CtorArgs, _Ctxt),
list.member(Var, ExistQVars),
- assoc_list.values(CtorArgs, CtorArgTypes),
+ CtorArgTypes = list.map(func(C) = C ^ arg_type, CtorArgs),
\+ type_list_contains_var(CtorArgTypes, Var),
constraint_list_get_tvars(Constraints, ConstraintTVars),
\+ list.member(Var, ConstraintTVars)
@@ -2608,7 +2608,7 @@
% the existential quantifiers.
list.member(Ctor, Ctors),
- Ctor = ctor(ExistQVars, Constraints, _CtorName, _CtorArgs),
+ Ctor = ctor(ExistQVars, Constraints, _CtorName, _CtorArgs, _Ctxt),
list.member(Constraint, Constraints),
Constraint = constraint(_Name, ConstraintArgs),
type_list_contains_var(ConstraintArgs, Var),
@@ -2650,7 +2650,7 @@
%-----------------------------------------------------------------------------%
parse_type_defn_head(ModuleName, Head, Body, Result) :-
- ( Head = term.variable(_) ->
+ ( Head = term.variable(_, _) ->
% `Head' has no term.context, so we need to get the
% context from `Body'.
( Body = term.functor(_, _, Context) ->
@@ -2677,7 +2677,7 @@
parse_type_defn_head_3(Name, Args, Head, Result) :-
% Check that all the head args are variables.
- ( var_list_to_term_list(Params0, Args) ->
+ ( term_list_to_var_list(Args, Params0) ->
% Check that all the head arg variables are distinct.
(
list.member(_, Params0, [Param | OtherParams]),
@@ -2786,10 +2786,16 @@
Result = error1(Errors)
;
Result1 = ok1(Args),
- Result = ok1(ctor(ExistQVars, Constraints, F, Args))
+ Ctxt = term_context(Term1),
+ Result = ok1(ctor(ExistQVars, Constraints, F, Args, Ctxt))
)
).
+:- func term_context(term(T)) = prog_context.
+
+term_context(functor(_, _, C)) = C.
+term_context(variable(_, C)) = C.
+
%-----------------------------------------------------------------------------%
% parse a `:- pred p(...)' declaration or a
@@ -3488,7 +3494,7 @@
convert_inst_defn_2(ok2(Name, ArgTerms), Head, Body, Result) :-
(
% Check that all the head args are variables.
- term.var_list_to_term_list(Args, ArgTerms)
+ term.term_list_to_var_list(ArgTerms, Args)
->
(
% Check that all the head arg variables are distinct.
@@ -3552,7 +3558,7 @@
convert_abstract_inst_defn_2(ok2(Name, ArgTerms), Head, Result) :-
(
% Check that all the head args are variables.
- term.var_list_to_term_list(Args, ArgTerms)
+ term.term_list_to_var_list(ArgTerms, Args)
->
(
% Check that all the head arg variables are distinct.
@@ -3619,7 +3625,7 @@
convert_mode_defn_2(ok2(Name, ArgTerms), Head, Body, Result) :-
(
% Check that all the head args are variables.
- term.var_list_to_term_list(Args, ArgTerms)
+ term.term_list_to_var_list(ArgTerms, Args)
->
(
% Check that all the head arg variables are distinct.
@@ -3870,7 +3876,7 @@
maybe1(module_name)::out) is det.
parse_module_name(DefaultModuleName, Term, Result) :-
- ( Term = term.variable(_) ->
+ ( Term = term.variable(_, _) ->
dummy_term(ErrorContext),
Msg = "module names starting with capital letters " ++
"must be quoted using single quotes (e.g. "":- module 'Foo'."")",
@@ -4190,7 +4196,7 @@
% Since variables don't have any term.context, if Term is
% a variable, we use ContainingTerm instead (hopefully that
% _will_ have a term.context).
- ( Term = term.variable(_) ->
+ ( Term = term.variable(_, _) ->
ErrorTerm0 = ContainingTerm
;
ErrorTerm0 = Term
@@ -4294,7 +4300,8 @@
parse_type(TypeTerm, TypeResult),
(
TypeResult = ok1(Type),
- Arg = MaybeFieldName - Type,
+ Context = term_context(TypeTerm),
+ Arg = ctor_arg(MaybeFieldName, Type, Context),
Result0 = convert_constructor_arg_list(ModuleName, Terms),
(
Result0 = error1(Errors),
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.39
diff -u -r1.39 prog_io_dcg.m
--- compiler/prog_io_dcg.m 20 Aug 2006 08:21:25 -0000 1.39
+++ compiler/prog_io_dcg.m 31 Oct 2006 04:52:46 -0000
@@ -73,7 +73,7 @@
parse_implicitly_qualified_term(ModuleName, DCG_Head, DCG_Body,
"DCG clause head", HeadResult),
process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var, Body,
- ProcessResult),
+ DCG_Context, ProcessResult),
add_context(ProcessResult, DCG_Context, Result)
;
MaybeBody = error1(Errors),
@@ -112,10 +112,9 @@
parse_dcg_goal(Term, MaybeGoal, !VarSet, !Counter, !Var) :-
% First, figure out the context for the goal.
(
- Term = term.functor(_, _, Context)
+ Term = term.functor(_, _, Ctxt)
;
- Term = term.variable(_),
- term.context_init(Context)
+ Term = term.variable(_, Ctxt)
),
% Next, parse it.
(
@@ -126,7 +125,7 @@
(
SymName = unqualified(Functor),
list.map(term.coerce, Args0, Args1),
- parse_dcg_goal_2(Functor, Args1, Context, MaybeGoalPrime,
+ parse_dcg_goal_2(Functor, Args1, Ctxt, MaybeGoalPrime,
!VarSet, !Counter, !Var)
->
MaybeGoal = MaybeGoalPrime
@@ -135,8 +134,9 @@
% as the DCG output var from this goal, and append the DCG argument
% pair to the non-terminal's argument list.
new_dcg_var(!VarSet, !Counter, Var),
- Args = Args0 ++ [term.variable(!.Var), term.variable(Var)],
- Goal = call_expr(SymName, Args, purity_pure) - Context,
+ Args = Args0 ++
+ [term.variable(!.Var, Ctxt), term.variable(Var, Ctxt)],
+ Goal = call_expr(SymName, Args, purity_pure) - Ctxt,
MaybeGoal = ok1(Goal),
!:Var = Var
)
@@ -147,8 +147,8 @@
new_dcg_var(!VarSet, !Counter, Var),
term.coerce(Term, ProgTerm),
Goal = call_expr(unqualified("call"),
- [ProgTerm, term.variable(!.Var), term.variable(Var)],
- purity_pure) - Context,
+ [ProgTerm, term.variable(!.Var, Ctxt), term.variable(Var, Ctxt)],
+ purity_pure) - Ctxt,
MaybeGoal = ok1(Goal),
!:Var = Var
).
@@ -257,7 +257,8 @@
parse_dcg_goal_2("[]", [], Context, MaybeGoal, !VarSet, !Counter, Var0, Var) :-
% Empty list - just unify the input and output DCG args.
new_dcg_var(!VarSet, !Counter, Var),
- Goal = unify_expr(term.variable(Var0), term.variable(Var), purity_pure)
+ Goal = unify_expr(
+ term.variable(Var0, Context), term.variable(Var, Context), purity_pure)
- Context,
MaybeGoal = ok1(Goal).
parse_dcg_goal_2("[|]", [X, Xs], Context, MaybeGoal, !VarSet, !Counter,
@@ -267,20 +268,20 @@
new_dcg_var(!VarSet, !Counter, Var),
ConsTerm0 = term.functor(term.atom("[|]"), [X, Xs], Context),
term.coerce(ConsTerm0, ConsTerm),
- term_list_append_term(ConsTerm, term.variable(Var), Term),
- Goal = unify_expr(term.variable(Var0), Term, purity_pure) - Context,
+ term_list_append_term(ConsTerm, term.variable(Var, Context), Term),
+ Goal = unify_expr(variable(Var0, Context), Term, purity_pure) - Context,
MaybeGoal = ok1(Goal).
parse_dcg_goal_2("=", [A0], Context, MaybeGoal, !VarSet, !Counter, Var, Var) :-
% Call to '='/1 - unify argument with DCG input arg.
term.coerce(A0, A),
- Goal = unify_expr(A, term.variable(Var), purity_pure) - Context,
+ Goal = unify_expr(A, variable(Var, Context), purity_pure) - Context,
MaybeGoal = ok1(Goal).
parse_dcg_goal_2(":=", [A0], Context, MaybeGoal, !VarSet, !Counter,
_Var0, Var) :-
% Call to ':='/1 - unify argument with DCG output arg.
new_dcg_var(!VarSet, !Counter, Var),
term.coerce(A0, A),
- Goal = unify_expr(A, term.variable(Var), purity_pure) - Context,
+ Goal = unify_expr(A, variable(Var, Context), purity_pure) - Context,
MaybeGoal = ok1(Goal).
parse_dcg_goal_2("if",
[term.functor(term.atom("then"), [CondTerm, ThenTerm], _)],
@@ -295,7 +296,7 @@
( Var = Var0 ->
Else = true_expr - Context
;
- Unify = unify_expr(term.variable(Var), term.variable(Var0),
+ Unify = unify_expr(variable(Var, Context), variable(Var0, Context),
purity_pure),
Else = Unify - Context
),
@@ -355,13 +356,15 @@
Goal = disj_expr(AGoal0, BGoal0) - Context
; VarA = Var0 ->
Var = VarB,
- Unify = unify_expr(term.variable(Var), term.variable(VarA),
+ Unify = unify_expr(
+ term.variable(Var, Context), term.variable(VarA, Context),
purity_pure),
append_to_disjunct(AGoal0, Unify, Context, AGoal),
Goal = disj_expr(AGoal, BGoal0) - Context
; VarB = Var0 ->
Var = VarA,
- Unify = unify_expr(term.variable(Var), term.variable(VarB),
+ Unify = unify_expr(
+ term.variable(Var, Context), term.variable(VarB, Context),
purity_pure),
append_to_disjunct(BGoal0, Unify, Context, BGoal),
Goal = disj_expr(AGoal0, BGoal) - Context
@@ -589,7 +592,8 @@
(
MaybeThen1 = ok1(Then1),
new_dcg_var(!VarSet, !Counter, Var),
- Unify = unify_expr(term.variable(Var), term.variable(Var2),
+ Unify = unify_expr(
+ term.variable(Var, Context), term.variable(Var2, Context),
purity_pure),
Then = conj_expr(Then1, Unify - Context) - Context,
MaybeThen = ok1(Then)
@@ -623,14 +627,16 @@
Else = Else1
; VarThen = Var0 ->
Var = VarElse,
- Unify = unify_expr(term.variable(Var), term.variable(VarThen),
+ Unify = unify_expr(
+ term.variable(Var, Context), term.variable(VarThen, Context),
purity_pure),
Then = conj_expr(Then1, Unify - Context) - Context,
Else = Else1
; VarElse = Var0 ->
Var = VarThen,
Then = Then1,
- Unify = unify_expr(term.variable(Var), term.variable(VarElse),
+ Unify = unify_expr(
+ term.variable(Var, Context), term.variable(VarElse, Context),
purity_pure),
Else = conj_expr(Else1, Unify - Context) - Context
;
@@ -676,10 +682,10 @@
).
:- pred process_dcg_clause(maybe_functor::in, prog_varset::in, prog_var::in,
- prog_var::in, goal::in, maybe1(item)::out) is det.
+ prog_var::in, goal::in, prog_context::in, maybe1(item)::out) is det.
-process_dcg_clause(ok2(Name, Args0), VarSet, Var0, Var, Body,
+process_dcg_clause(ok2(Name, Args0), VarSet, Var0, Var, Body, Ctxt,
ok1(item_clause(user, VarSet, predicate, Name, Args, Body))) :-
list.map(term.coerce, Args0, Args1),
- Args = Args1 ++ [term.variable(Var0), term.variable(Var)].
-process_dcg_clause(error2(Errors), _, _, _, _, error1(Errors)).
+ Args = Args1 ++ [term.variable(Var0, Ctxt), term.variable(Var, Ctxt)].
+process_dcg_clause(error2(Errors), _, _, _, _, _, error1(Errors)).
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.48
diff -u -r1.48 prog_io_goal.m
--- compiler/prog_io_goal.m 20 Sep 2006 09:33:08 -0000 1.48
+++ compiler/prog_io_goal.m 31 Oct 2006 04:52:46 -0000
@@ -107,8 +107,7 @@
(
Term = term.functor(_, _, Context)
;
- Term = term.variable(_),
- term.context_init(Context)
+ Term = term.variable(_, Context)
),
% We just check if it matches the appropriate pattern for one of the
% builtins. If it doesn't match any of the builtins, then it's just
@@ -647,7 +646,7 @@
Msg = "invalid trace goal paramater",
MaybeComponentsTerms = error1([Msg - Term])
;
- Term = term.variable(_),
+ Term = term.variable(_, _),
Msg = "expected trace goal paramater, found variable",
ErrorTerm = term.functor(term.atom(""), [], Context),
MaybeComponentsTerms = error1([Msg - ErrorTerm])
@@ -711,7 +710,7 @@
( SubTerms = [SubTerm] ->
(
SubTerm = term.functor(term.atom("!"),
- [term.variable(Var)], _)
+ [term.variable(Var, _)], _)
->
term.coerce_var(Var, ProgVar),
Component = trace_component_maybe_io(ProgVar),
@@ -737,7 +736,7 @@
SubTermA = term.functor(_, _, _),
MutableErrorTerm = SubTermA
;
- SubTermA = term.variable(_),
+ SubTermA = term.variable(_, _),
MutableErrorTerm = Term
),
MutableMsg = "the first argument of " ++ Atom ++
@@ -746,7 +745,7 @@
),
(
SubTermB = term.functor(term.atom("!"),
- [term.variable(Var)], _)
+ [term.variable(Var, _)], _)
->
MaybeVar = ok1(Var)
;
@@ -754,7 +753,7 @@
SubTermB = term.functor(_, _, _),
VarErrorTerm = SubTermB
;
- SubTermB = term.variable(_),
+ SubTermB = term.variable(_, _),
VarErrorTerm = Term
),
VarMsg = "the second argument of " ++ Atom ++
@@ -789,7 +788,7 @@
MaybeComponentTerm = error1([Msg - Term])
)
;
- Term = term.variable(_),
+ Term = term.variable(_, _),
Msg = "expected trace goal paramater, found variable",
MaybeComponentTerm = error1([Msg - ErrorTerm])
).
@@ -904,7 +903,7 @@
MaybeCompiletime = error1([Msg - Term])
)
;
- Term = term.variable(_),
+ Term = term.variable(_, _),
Msg = "expected compile_time paramater, found variable",
MaybeCompiletime = error1([Msg - ErrorTerm])
).
@@ -956,7 +955,7 @@
MaybeRuntime = error1([Msg - Term])
)
;
- Term = term.variable(_),
+ Term = term.variable(_, _),
Msg = "expected run_time paramater, found variable",
MaybeRuntime = error1([Msg - ErrorTerm])
).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.115
diff -u -r1.115 prog_io_pragma.m
--- compiler/prog_io_pragma.m 2 Oct 2006 05:21:21 -0000 1.115
+++ compiler/prog_io_pragma.m 31 Oct 2006 04:52:46 -0000
@@ -1823,7 +1823,7 @@
parse_pragma_c_code_varlist(VarSet, [V|Vars], PragmaVars, Error):-
(
V = term.functor(term.atom("::"), [VarTerm, ModeTerm], _),
- VarTerm = term.variable(Var)
+ VarTerm = term.variable(Var, _)
->
( varset.search_name(VarSet, Var, VarName) ->
( convert_mode(allow_constrained_inst_var, ModeTerm, Mode0) ->
@@ -2180,8 +2180,8 @@
:- pred convert_list(term::in, pred(term, T)::(pred(in, out) is semidet),
string::in, maybe1(list(T))::out) is det.
-convert_list(term.variable(V), _, UnrecognizedMsg,
- error1([UnrecognizedMsg - term.variable(V)])).
+convert_list(term.variable(V, C), _, UnrecognizedMsg,
+ error1([UnrecognizedMsg - term.variable(V, C)])).
convert_list(term.functor(Functor, Args, Context), Pred, UnrecognizedMsg,
Result) :-
(
@@ -2220,8 +2220,8 @@
pred(term, maybe1(T))::(pred(in, out) is semidet),
string::in, maybe1(list(T))::out) is det.
-convert_maybe_list(term.variable(V), _, UnrecognizedMsg,
- error1([UnrecognizedMsg - term.variable(V)])).
+convert_maybe_list(term.variable(V, C), _, UnrecognizedMsg,
+ error1([UnrecognizedMsg - term.variable(V, C)])).
convert_maybe_list(term.functor(Functor, Args, Context), Pred, UnrecognizedMsg,
Result) :-
(
@@ -2261,7 +2261,7 @@
convert_type_spec_pair(Term, TypeSpec) :-
Term = term.functor(term.atom("="), [TypeVarTerm, SpecTypeTerm0], _),
- TypeVarTerm = term.variable(TypeVar0),
+ TypeVarTerm = term.variable(TypeVar0, _),
term.coerce_var(TypeVar0, TypeVar),
parse_type(SpecTypeTerm0, ok1(SpecType)),
TypeSpec = TypeVar - SpecType.
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.56
diff -u -r1.56 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 19 Oct 2006 07:29:48 -0000 1.56
+++ compiler/prog_io_typeclass.m 31 Oct 2006 04:52:46 -0000
@@ -233,7 +233,7 @@
MaybeClassName = ok2(ClassName, TermVars0),
list.map(term.coerce, TermVars0, TermVars),
(
- term.var_list_to_term_list(Vars, TermVars),
+ term.term_list_to_var_list(TermVars, Vars),
list.sort_and_remove_dups(TermVars, SortedTermVars),
list.length(SortedTermVars) = list.length(TermVars) : int
->
@@ -482,7 +482,7 @@
parse_inst_constraint(Term, InstVar, Inst) :-
Term = term.functor(term.atom("=<"), [Arg1, Arg2], _),
- Arg1 = term.variable(InstVar0),
+ Arg1 = term.variable(InstVar0, _),
term.coerce_var(InstVar0, InstVar),
convert_inst(no_allow_constrained_inst_var, Arg2, Inst).
@@ -506,7 +506,7 @@
parse_fundep_2(Term, TVars) :-
TypeTerm = term.coerce(Term),
conjunction_to_list(TypeTerm, List),
- term.var_list_to_term_list(TVars, List).
+ term.term_list_to_var_list(List, TVars).
:- pred constraint_is_not_simple(prog_constraint::in) is semidet.
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.54
diff -u -r1.54 prog_io_util.m
--- compiler/prog_io_util.m 2 Oct 2006 05:21:21 -0000 1.54
+++ compiler/prog_io_util.m 31 Oct 2006 04:52:46 -0000
@@ -287,7 +287,7 @@
%
parse_type(Term, Result) :-
(
- Term = term.variable(Var0)
+ Term = term.variable(Var0, _)
->
term.coerce_var(Var0, Var),
Result = ok1(type_variable(Var, kind_star))
@@ -391,7 +391,7 @@
Term = Term0
).
-unparse_type(type_variable(TVar, _), term.variable(Var)) :-
+unparse_type(type_variable(TVar, _), term.variable(Var, context_init)) :-
Var = term.coerce_var(TVar).
unparse_type(defined_type(SymName, Args, _), Term) :-
unparse_type_list(Args, ArgTerms),
@@ -423,7 +423,7 @@
Context = term.context_init,
Var = term.coerce_var(TVar),
unparse_type_list(Args, ArgTerms),
- Term = term.functor(term.atom(""), [term.variable(Var) | ArgTerms],
+ Term = term.functor(term.atom(""), [term.variable(Var, Context) | ArgTerms],
Context).
unparse_type(kinded_type(_, _), _) :-
unexpected(this_file, "prog_io_util: kind annotation").
@@ -522,7 +522,7 @@
convert_inst(AllowConstrainedInstVar, H0, H),
convert_inst_list(AllowConstrainedInstVar, T0, T).
-convert_inst(_, term.variable(V0), inst_var(V)) :-
+convert_inst(_, term.variable(V0, _), inst_var(V)) :-
term.coerce_var(V0, V).
convert_inst(AllowConstrainedInstVar, Term, Result) :-
Term = term.functor(term.atom(Name), Args0, _Context),
@@ -579,7 +579,7 @@
Result)
; Name = "=<", Args0 = [VarTerm, InstTerm] ->
AllowConstrainedInstVar = allow_constrained_inst_var,
- VarTerm = term.variable(Var),
+ VarTerm = term.variable(Var, _),
% Do not allow nested constrained_inst_vars.
convert_inst(no_allow_constrained_inst_var, InstTerm, Inst),
Result = constrained_inst_vars(set.make_singleton_set(
@@ -752,14 +752,14 @@
parse_list_of_vars(term.functor(term.atom("[]"), [], _), []).
parse_list_of_vars(term.functor(term.atom("[|]"), [Head, Tail], _),
[V | Vs]) :-
- Head = term.variable(V),
+ Head = term.variable(V, _),
parse_list_of_vars(Tail, Vs).
parse_vars(Term, MaybeVars) :-
( Term = functor(atom("[]"), [], _) ->
MaybeVars = ok1([])
; Term = functor(atom("[|]"), [Head, Tail], _) ->
- ( Head = variable(V) ->
+ ( Head = variable(V, _) ->
parse_vars(Tail, MaybeVarsTail),
(
MaybeVarsTail = ok1(TailVars),
@@ -784,11 +784,11 @@
; Term = functor(atom("[|]"), [Head, Tail], _) ->
(
(
- Head = functor(atom("!"), [variable(SV)], _),
+ Head = functor(atom("!"), [variable(SV, _)], _),
HeadVars = [],
HeadStateVars = [SV]
;
- Head = variable(V),
+ Head = variable(V, _),
HeadVars = [V],
HeadStateVars = []
)
@@ -818,22 +818,22 @@
; Term = functor(atom("[|]"), [Head, Tail], _) ->
(
(
- Head = functor(atom("!"), [variable(SV)], _),
+ Head = functor(atom("!"), [variable(SV, _)], _),
HeadVars = [],
HeadDotVars = [SV],
HeadColonVars = [SV]
;
- Head = functor(atom("!."), [variable(SV)], _),
+ Head = functor(atom("!."), [variable(SV, _)], _),
HeadVars = [],
HeadDotVars = [SV],
HeadColonVars = []
;
- Head = functor(atom("!:"), [variable(SV)], _),
+ Head = functor(atom("!:"), [variable(SV, _)], _),
HeadVars = [],
HeadDotVars = [],
HeadColonVars = [SV]
;
- Head = variable(V),
+ Head = variable(V, _),
HeadVars = [V],
HeadDotVars = [],
HeadColonVars = []
Index: compiler/prog_mode.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.18
diff -u -r1.18 prog_mode.m
--- compiler/prog_mode.m 4 Oct 2006 06:36:56 -0000 1.18
+++ compiler/prog_mode.m 31 Oct 2006 04:52:46 -0000
@@ -396,7 +396,7 @@
).
rename_apart_inst_vars_in_inst(_, not_reached, not_reached).
rename_apart_inst_vars_in_inst(Sub, inst_var(Var0), inst_var(Var)) :-
- ( map.search(Sub, Var0, term.variable(Var1)) ->
+ ( map.search(Sub, Var0, term.variable(Var1, _)) ->
Var = Var1
;
Var = Var0
@@ -405,7 +405,7 @@
constrained_inst_vars(Vars, Inst)) :-
rename_apart_inst_vars_in_inst(Sub, Inst0, Inst),
Vars = set.map(func(Var0) =
- ( map.search(Sub, Var0, term.variable(Var)) ->
+ ( map.search(Sub, Var0, term.variable(Var, _)) ->
Var
;
Var0
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.28
diff -u -r1.28 prog_type.m
--- compiler/prog_type.m 2 Oct 2006 05:21:22 -0000 1.28
+++ compiler/prog_type.m 31 Oct 2006 04:52:46 -0000
@@ -754,7 +754,7 @@
is_builtin_dummy_argument_type("store", "store", 1). % store.store/1.
constructor_list_represents_dummy_argument_type([Ctor], no) :-
- Ctor = ctor([], [], _, []).
+ Ctor = ctor([], [], _, [], _).
type_is_io_state(Type) :-
type_to_ctor_and_args(Type, TypeCtor, []),
@@ -943,7 +943,7 @@
type_is_single_ctor_single_arg(Ctors, Ctor, MaybeArgName, ArgType) :-
Ctors = [SingleCtor],
SingleCtor = ctor(ExistQVars, _Constraints, Ctor,
- [MaybeArgName - ArgType]),
+ [ctor_arg(MaybeArgName, ArgType, _)], _Ctxt),
ExistQVars = [].
:- pred ctor_is_type_info(sym_name::in) is semidet.
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.95
diff -u -r1.95 prog_util.m
--- compiler/prog_util.m 7 Sep 2006 05:51:04 -0000 1.95
+++ compiler/prog_util.m 31 Oct 2006 04:52:46 -0000
@@ -469,16 +469,16 @@
rename_in_goal_expr(OldVar, NewVar,
event_expr(Name, Terms0),
event_expr(Name, Terms)) :-
- term.substitute_list(Terms0, OldVar, term.variable(NewVar), Terms).
+ term.substitute_list(Terms0, OldVar, variable(NewVar, context_init), Terms).
rename_in_goal_expr(OldVar, NewVar,
call_expr(SymName, Terms0, Purity),
call_expr(SymName, Terms, Purity)) :-
- term.substitute_list(Terms0, OldVar, term.variable(NewVar), Terms).
+ term.substitute_list(Terms0, OldVar, variable(NewVar, context_init), Terms).
rename_in_goal_expr(OldVar, NewVar,
unify_expr(TermA0, TermB0, Purity),
unify_expr(TermA, TermB, Purity)) :-
- term.substitute(TermA0, OldVar, term.variable(NewVar), TermA),
- term.substitute(TermB0, OldVar, term.variable(NewVar), TermB).
+ term.substitute(TermA0, OldVar, term.variable(NewVar, context_init), TermA),
+ term.substitute(TermB0, OldVar, term.variable(NewVar, context_init), TermB).
:- pred rename_in_trace_mutable_var(prog_var::in, prog_var::in,
trace_mutable_var::in, trace_mutable_var::out) is det.
@@ -779,8 +779,8 @@
:- func substitute_var(substitution(T), var(T)) = var(T).
substitute_var(Subst, Var0) = Var :-
- term.apply_substitution(term.variable(Var0), Subst, Term),
- ( Term = term.variable(Var1) ->
+ term.apply_substitution(term.variable(Var0, context_init), Subst, Term),
+ ( Term = term.variable(Var1, _) ->
Var = Var1
;
unexpected(this_file, "substitute_var: invalid substitution")
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.36
diff -u -r1.36 recompilation.check.m
--- compiler/recompilation.check.m 15 Oct 2006 23:26:50 -0000 1.36
+++ compiler/recompilation.check.m 31 Oct 2006 04:52:46 -0000
@@ -1136,7 +1136,7 @@
constructor::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
-check_functor_ambiguities(NeedQualifier, TypeCtor, ctor(_, _, Name, Args),
+check_functor_ambiguities(NeedQualifier, TypeCtor, ctor(_, _, Name, Args, _),
!Info) :-
TypeCtorItem = type_ctor_to_item_name(TypeCtor),
ResolvedCtor = resolved_functor_constructor(TypeCtorItem),
@@ -1152,9 +1152,9 @@
constructor_arg::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
-check_field_ambiguities(_, _, no - _, !Info).
-check_field_ambiguities(NeedQualifier, ResolvedCtor, yes(FieldName) - _,
- !Info) :-
+check_field_ambiguities(_, _, ctor_arg(no, _, _) , !Info).
+check_field_ambiguities(NeedQualifier, ResolvedCtor,
+ ctor_arg(yes(FieldName), _, _), !Info) :-
% XXX The arities to match below will need to change if we ever
% allow taking the address of field access functions.
field_access_function_name(get, FieldName, ExtractFuncName),
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.40
diff -u -r1.40 recompilation.usage.m
--- compiler/recompilation.usage.m 15 Oct 2006 23:26:51 -0000 1.40
+++ compiler/recompilation.usage.m 31 Oct 2006 04:52:46 -0000
@@ -1068,7 +1068,7 @@
recompilation_usage_info::in, recompilation_usage_info::out) is det.
find_items_used_by_ctor(Ctor, !Info) :-
- Ctor = ctor(_, Constraints, _, CtorArgs),
+ Ctor = ctor(_, Constraints, _, CtorArgs, _),
find_items_used_by_class_constraints(Constraints, !Info),
list.foldl(find_items_used_by_ctor_arg, CtorArgs, !Info).
@@ -1076,7 +1076,7 @@
recompilation_usage_info::in, recompilation_usage_info::out) is det.
find_items_used_by_ctor_arg(CtorArg, !Info) :-
- CtorArg = _ - ArgType,
+ ArgType = CtorArg ^ arg_type,
find_items_used_by_type(ArgType, !Info).
:- pred find_items_used_by_mode_defn(hlds_mode_defn::in,
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.66
diff -u -r1.66 special_pred.m
--- compiler/special_pred.m 1 Oct 2006 04:57:32 -0000 1.66
+++ compiler/special_pred.m 31 Oct 2006 04:52:46 -0000
@@ -263,7 +263,7 @@
SpecialPredId \= spec_pred_init,
Ctors = Body ^ du_type_ctors,
list.member(Ctor, Ctors),
- Ctor = ctor(ExistQTVars, _, _, _),
+ Ctor = ctor(ExistQTVars, _, _, _, _),
ExistQTVars = [_ | _]
;
SpecialPredId = spec_pred_init,
Index: compiler/state_var.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.18
diff -u -r1.18 state_var.m
--- compiler/state_var.m 13 Oct 2006 04:52:25 -0000 1.18
+++ compiler/state_var.m 31 Oct 2006 04:52:46 -0000
@@ -950,12 +950,12 @@
:- func expand_bang_state_var(prog_term, list(prog_term)) = list(prog_term).
-expand_bang_state_var(T @ variable(_), Ts) = [T | Ts].
+expand_bang_state_var(T @ variable(_, _), Ts) = [T | Ts].
expand_bang_state_var(T @ functor(Const, Args, Ctxt), Ts) =
(
Const = atom("!"),
- Args = [variable(_StateVar)]
+ Args = [variable(_StateVar, _)]
->
[functor(atom("!."), Args, Ctxt), functor(atom("!:"), Args, Ctxt) | Ts]
;
@@ -1015,15 +1015,15 @@
substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !Specs) :-
(
- Arg0 = functor(atom("!."), [variable(StateVar)], Context)
+ Arg0 = functor(atom("!."), [variable(StateVar, _)], Context)
->
dot(Context, StateVar, Var, !VarSet, !SInfo, !Specs),
- Arg = variable(Var)
+ Arg = variable(Var, context_init)
;
- Arg0 = functor(atom("!:"), [variable(StateVar)], Context)
+ Arg0 = functor(atom("!:"), [variable(StateVar, _)], Context)
->
colon(Context, StateVar, Var, !VarSet, !SInfo, !Specs),
- Arg = variable(Var)
+ Arg = variable(Var, context_init)
;
Arg = Arg0
).
@@ -1031,12 +1031,12 @@
%-----------------------------------------------------------------------------%
illegal_state_var_func_result(function, Args, StateVar) :-
- list.last(Args, functor(atom("!"), [variable(StateVar)], _Ctxt)).
+ list.last(Args, functor(atom("!"), [variable(StateVar, _)], _Ctxt)).
%-----------------------------------------------------------------------------%
lambda_args_contain_bang_state_var([Arg | Args], StateVar) :-
- ( Arg = functor(atom("!"), [variable(StateVar0)], _) ->
+ ( Arg = functor(atom("!"), [variable(StateVar0, _)], _) ->
StateVar = StateVar0
;
lambda_args_contain_bang_state_var(Args, StateVar)
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.21
diff -u -r1.21 superhomogeneous.m
--- compiler/superhomogeneous.m 10 Sep 2006 23:39:09 -0000 1.21
+++ compiler/superhomogeneous.m 31 Oct 2006 04:52:46 -0000
@@ -307,14 +307,14 @@
do_insert_arg_unification(Var, Arg, Context, ArgContext, N1, ArgUnifyConj,
MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !Specs) :-
- ( Arg = term.variable(Var) ->
+ ( Arg = term.variable(Var, _) ->
% Skip unifications of the form `X = X'
ArgUnifyConj = [],
NumAdded = 0
;
arg_context_to_unify_context(ArgContext, N1, UnifyMainContext,
UnifySubContext),
- do_unravel_unification(term.variable(Var), Arg, Context,
+ do_unravel_unification(term.variable(Var, Context), Arg, Context,
UnifyMainContext, UnifySubContext, purity_pure, Goal,
MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !Specs),
@@ -384,14 +384,14 @@
do_append_arg_unification(Var, Arg, Context, ArgContext, N1, ConjList,
MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !Specs) :-
- ( Arg = term.variable(Var) ->
+ ( Arg = term.variable(Var, _) ->
% Skip unifications of the form `X = X'.
ConjList = [],
NumAdded = 0
;
arg_context_to_unify_context(ArgContext, N1, UnifyMainContext,
UnifySubContext),
- do_unravel_unification(term.variable(Var), Arg, Context,
+ do_unravel_unification(term.variable(Var, Context), Arg, Context,
UnifyMainContext, UnifySubContext, purity_pure, Goal,
MaybeThreshold, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
!SInfo, !Specs),
@@ -418,7 +418,7 @@
(
MaybeThreshold = yes(Threshold),
NumAdded > Threshold,
- LHS = term.variable(X),
+ LHS = term.variable(X, _),
ground_term(RHS)
->
Goal0 = _ - GoalInfo,
@@ -439,20 +439,20 @@
!Specs) :-
(
% `X = Y' needs no unravelling.
- TermX = term.variable(X),
- TermY = term.variable(Y),
+ TermX = term.variable(X, _),
+ TermY = term.variable(Y, _),
make_atomic_unification(X, rhs_var(Y), Context, MainContext,
SubContext, Purity, Goal, !QualInfo),
NumAdded = 0
;
- TermX = term.variable(X),
+ TermX = term.variable(X, _),
TermY = term.functor(F, Args, FunctorContext),
unravel_var_functor_unification(X, F, Args, FunctorContext,
Context, MainContext, SubContext, Purity, Goal, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
;
TermX = term.functor(F, Args, FunctorContext),
- TermY = term.variable(Y),
+ TermY = term.variable(Y, _),
unravel_var_functor_unification(Y, F, Args, FunctorContext,
Context, MainContext, SubContext, Purity, Goal, NumAdded,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
@@ -465,10 +465,10 @@
TermX = term.functor(_, _, _),
TermY = term.functor(_, _, _),
varset.new_var(!.VarSet, TmpVar, !:VarSet),
- do_unravel_unification(term.variable(TmpVar), TermX,
+ do_unravel_unification(term.variable(TmpVar, Context), TermX,
Context, MainContext, SubContext, Purity, GoalX, no, NumAddedX,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- do_unravel_unification(term.variable(TmpVar), TermY,
+ do_unravel_unification(term.variable(TmpVar, Context), TermY,
Context, MainContext, SubContext, Purity, GoalY, no, NumAddedY,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
goal_to_conj_list(GoalX, ConjListX),
@@ -530,18 +530,18 @@
report_error_in_type_qualification(GenericVarSet, Context),
Errors, !Specs)
),
- do_unravel_unification(term.variable(X), RVal, Context, MainContext,
- SubContext, Purity, Goal, no, NumAdded, !VarSet, !ModuleInfo,
- !QualInfo, !SInfo, !Specs)
+ do_unravel_unification(term.variable(X, Context), RVal,
+ Context, MainContext, SubContext, Purity, Goal, no, NumAdded,
+ !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs)
;
% Handle unification expressions.
F = term.atom("@"),
Args = [LVal, RVal]
->
- do_unravel_unification(term.variable(X), LVal, Context,
+ do_unravel_unification(term.variable(X, Context), LVal, Context,
MainContext, SubContext, Purity, Goal1, no, NumAdded1,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
- do_unravel_unification(term.variable(X), RVal, Context,
+ do_unravel_unification(term.variable(X, Context), RVal, Context,
MainContext, SubContext, Purity, Goal2, no, NumAdded2,
!VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
NumAdded = NumAdded1 + NumAdded2,
@@ -603,7 +603,8 @@
parse_dcg_pred_goal(GoalTerm, MaybeParsedGoal, DCG0, DCGn, !VarSet),
(
MaybeParsedGoal = ok1(ParsedGoal),
- Vars1 = Vars0 ++ [term.variable(DCG0), term.variable(DCGn)],
+ Vars1 = Vars0 ++
+ [term.variable(DCG0, Context), term.variable(DCGn, Context)],
build_lambda_expression(X, Purity, DCGLambdaPurity, predicate,
EvalMethod, Vars1, Modes, Det, ParsedGoal, Context, MainContext,
SubContext, Goal0, NumAdded, !VarSet, !ModuleInfo, !QualInfo,
@@ -646,13 +647,13 @@
finish_if_then_else_expr_condition(BeforeSInfo, !SInfo),
- do_unravel_unification(term.variable(X), ThenTerm,
+ do_unravel_unification(term.variable(X, Context), ThenTerm,
Context, MainContext, SubContext, Purity, ThenGoal, no,
ThenAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
finish_if_then_else_expr_then_goal(StateVars, BeforeSInfo, !SInfo),
- do_unravel_unification(term.variable(X), ElseTerm,
+ do_unravel_unification(term.variable(X, Context), ElseTerm,
Context, MainContext, SubContext, Purity, ElseGoal, no,
ElseAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs),
@@ -1061,7 +1062,7 @@
make_fresh_arg_var(Arg0, Var, Vars0, !VarSet, !SInfo, !Specs) :-
substitute_state_var_mapping(Arg0, Arg, !VarSet, !SInfo, !Specs),
(
- Arg = term.variable(ArgVar),
+ Arg = term.variable(ArgVar, _),
\+ list.member(ArgVar, Vars0)
->
Var = ArgVar
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.130
diff -u -r1.130 switch_detection.m
--- compiler/switch_detection.m 27 Sep 2006 06:17:05 -0000 1.130
+++ compiler/switch_detection.m 31 Oct 2006 04:52:46 -0000
@@ -605,10 +605,10 @@
% Check whether the unification is a deconstruction unification
% on either Var or on a variable aliased to Var.
UnifyInfo0 = deconstruct(UnifyVar, _, _, _, _, _),
- term.apply_rec_substitution(term.variable(Var),
- !.Subst, term.variable(SubstVar)),
- term.apply_rec_substitution(term.variable(UnifyVar),
- !.Subst, term.variable(SubstUnifyVar)),
+ term.apply_rec_substitution(term.variable(Var, context_init),
+ !.Subst, term.variable(SubstVar, context_init)),
+ term.apply_rec_substitution(term.variable(UnifyVar, context_init),
+ !.Subst, term.variable(SubstUnifyVar, context_init)),
SubstVar = SubstUnifyVar
->
call(ProcessUnify, Var, Goal0, Goals, !Result, !Info),
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.12
diff -u -r1.12 term_constr_build.m
--- compiler/term_constr_build.m 20 Sep 2006 09:42:14 -0000 1.12
+++ compiler/term_constr_build.m 31 Oct 2006 04:52:46 -0000
@@ -1101,7 +1101,7 @@
"find_deconstruct_fail_bound/3: non cons cons_id.")
),
FindComplement = (pred(Ctor::in) is semidet :-
- Ctor = ctor(_, _, SymName, Args),
+ Ctor = ctor(_, _, SymName, Args, _),
list.length(Args, Arity),
not (
SymName = ConsName,
@@ -1155,7 +1155,7 @@
:- func lower_bound(functor_info, module_info, type_ctor, constructor) = int.
lower_bound(Norm, Module, TypeCtor, Constructor) = LowerBound :-
- Constructor = ctor(_, _, SymName, Args),
+ Constructor = ctor(_, _, SymName, Args, _),
Arity = list.length(Args),
ConsId = cons(SymName, Arity),
LowerBound = functor_lower_bound(Norm, TypeCtor, ConsId, Module).
@@ -1179,8 +1179,9 @@
% finite size but I'm not sure that it's worth it.
%
FindUpperBound = (pred(Ctor::in, !.B::in, !:B::out) is semidet :-
- Ctor = ctor(_, _, SymName, Args),
- all [Arg] (list.member(Arg, Args) => zero_size_type(Module, snd(Arg))),
+ Ctor = ctor(_, _, SymName, Args, _),
+ all [Arg] (list.member(Arg, Args) =>
+ zero_size_type(Module, Arg ^ arg_type)),
Arity = list.length(Args),
ConsId = cons(SymName, Arity),
Bound = functor_lower_bound(Norm, TypeCtor, ConsId, Module),
Index: compiler/term_norm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_norm.m,v
retrieving revision 1.22
diff -u -r1.22 term_norm.m
--- compiler/term_norm.m 22 Aug 2006 05:04:10 -0000 1.22
+++ compiler/term_norm.m 31 Oct 2006 04:52:46 -0000
@@ -181,7 +181,7 @@
% of counted arguments.
find_weights_for_cons(TypeCtor, Params, Ctor, !Weights) :-
- Ctor = ctor(_ExistQVars, _Constraints, SymName, Args),
+ Ctor = ctor(_ExistQVars, _Constraints, SymName, Args, _),
list.length(Args, Arity),
( Arity > 0 ->
find_and_count_nonrec_args(Args, TypeCtor, Params,
@@ -226,7 +226,7 @@
list(type_param)::in) is semidet.
is_arg_recursive(Arg, TypeCtor, Params) :-
- Arg = _Name - ArgType,
+ ArgType = Arg ^ arg_type,
type_to_ctor_and_args(ArgType, ArgTypeCtor, ArgTypeArgs),
TypeCtor = ArgTypeCtor,
prog_type.type_list_to_var_list(ArgTypeArgs, ArgTypeParams),
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.84
diff -u -r1.84 type_ctor_info.m
--- compiler/type_ctor_info.m 27 Sep 2006 06:17:05 -0000 1.84
+++ compiler/type_ctor_info.m 31 Oct 2006 04:52:46 -0000
@@ -601,7 +601,7 @@
make_enum_functors([], _, _, []).
make_enum_functors([Functor | Functors], NextOrdinal0, ConsTagMap,
[EnumFunctor | EnumFunctors]) :-
- Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
+ Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs, _Context),
expect(unify(ExistTvars, []), this_file,
"existential arguments in functor in enum"),
expect(unify(Constraints, []), this_file,
@@ -695,7 +695,7 @@
make_maybe_res_functors([], _, _, _, _, []).
make_maybe_res_functors([Functor | Functors], NextOrdinal, ConsTagMap,
TypeArity, ModuleInfo, [MaybeResFunctor | MaybeResFunctors]) :-
- Functor = ctor(ExistTvars, Constraints, SymName, ConstructorArgs),
+ Functor = ctor(ExistTvars, Constraints, SymName, ConstructorArgs, _Context),
list.length(ConstructorArgs, Arity),
FunctorName = unqualify_name(SymName),
ConsId = make_cons_id_from_qualified_sym_name(SymName, ConstructorArgs),
@@ -774,7 +774,7 @@
du_arg_info::out) is det.
generate_du_arg_info(NumUnivTvars, ExistTvars, ConstructorArg, ArgInfo) :-
- ConstructorArg = MaybeArgSymName - ArgType,
+ ConstructorArg = ctor_arg(MaybeArgSymName, ArgType, _Ctxt),
(
MaybeArgSymName = yes(SymName),
ArgName = unqualify_name(SymName),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.173
diff -u -r1.173 type_util.m
--- compiler/type_util.m 22 Oct 2006 09:14:25 -0000 1.173
+++ compiler/type_util.m 31 Oct 2006 04:52:46 -0000
@@ -315,6 +315,7 @@
:- import_module int.
:- import_module map.
:- import_module pair.
+:- import_module term.
%-----------------------------------------------------------------------------%
@@ -608,9 +609,11 @@
% Tuples are never existentially typed.
ExistQVars = [],
ClassConstraints = [],
- CtorArgs = list.map((func(ArgType) = no - ArgType), TypeArgs),
+ Context = term.context_init,
+ CtorArgs = list.map(
+ (func(ArgType) = ctor_arg(no, ArgType, Context)), TypeArgs),
Constructors = [ctor(ExistQVars, ClassConstraints, unqualified("{}"),
- CtorArgs)]
+ CtorArgs, Context)]
;
module_info_get_type_table(ModuleInfo, TypeTable),
map.search(TypeTable, TypeCtor, TypeDefn),
@@ -646,17 +649,18 @@
% constraints can only contain existentially quantified variables,
% so there's no need to worry about applying the substitution to ExistQVars
% or Constraints.
- Ctor0 = ctor(ExistQVars, Constraints, Name, Args0),
+ Ctor0 = ctor(ExistQVars, Constraints, Name, Args0, Ctxt),
substitute_type_args_3(Subst, Args0, Args),
substitute_type_args_2(Subst, Ctors0, Ctors),
- Ctor = ctor(ExistQVars, Constraints, Name, Args).
+ Ctor = ctor(ExistQVars, Constraints, Name, Args, Ctxt).
:- pred substitute_type_args_3(tsubst::in, list(constructor_arg)::in,
list(constructor_arg)::out) is det.
substitute_type_args_3(_, [], []).
-substitute_type_args_3(Subst, [Name - Arg0 | Args0], [Name - Arg | Args]) :-
- apply_subst_to_type(Subst, Arg0, Arg),
+substitute_type_args_3(Subst, [Arg0 | Args0], [Arg | Args]) :-
+ apply_subst_to_type(Subst, Arg0 ^ arg_type, ArgType),
+ Arg = Arg0 ^ arg_type := ArgType,
substitute_type_args_3(Subst, Args0, Args).
%-----------------------------------------------------------------------------%
@@ -732,7 +736,7 @@
),
map.from_corresponding_lists(TypeParams, TypeArgs, TSubst),
- assoc_list.values(Args, ArgTypes0),
+ ArgTypes0 = list.map(func(C) = C ^ arg_type, Args),
apply_subst_to_type_list(TSubst, ArgTypes0, ArgTypes)
;
ArgTypes = []
@@ -760,7 +764,7 @@
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
map.from_corresponding_lists(TypeParams, TypeArgs, TSubst),
- assoc_list.values(Args, ArgTypes0),
+ ArgTypes0 = list.map(func(C) = C ^ arg_type, Args),
apply_subst_to_type_list(TSubst, ArgTypes0, ArgTypes).
is_existq_cons(ModuleInfo, VarType, ConsId) :-
@@ -804,7 +808,7 @@
get_existq_cons_defn(ModuleInfo, VarType, ConsId, CtorDefn) :-
is_existq_cons(ModuleInfo, VarType, ConsId, ConsDefn),
ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Args, _, _),
- assoc_list.values(Args, ArgTypes),
+ ArgTypes = list.map(func(C) = C ^ arg_type, Args),
module_info_get_type_table(ModuleInfo, Types),
type_to_ctor_and_args(VarType, TypeCtor, _),
map.lookup(Types, TypeCtor, TypeDefn),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.408
diff -u -r1.408 typecheck.m
--- compiler/typecheck.m 22 Oct 2006 09:14:25 -0000 1.408
+++ compiler/typecheck.m 31 Oct 2006 04:52:46 -0000
@@ -2292,7 +2292,7 @@
apply_substitution_to_var_list(Vars0, RenameSubst, Vars) :-
term.var_list_to_term_list(Vars0, Terms0),
term.apply_substitution_to_list(Terms0, RenameSubst, Terms),
- term.term_list_to_var_list(Terms, Vars).
+ Vars = term.term_list_to_var_list(Terms).
:- pred apply_var_renaming_to_var_list(list(var(T))::in, map(var(T),
var(T))::in, list(var(T))::out) is det.
@@ -3025,7 +3025,7 @@
convert_cons_defn(Info, GoalPath, Action, HLDS_ConsDefn, ConsTypeInfo) :-
HLDS_ConsDefn = hlds_cons_defn(ExistQVars0, ExistProgConstraints, Args,
TypeCtor, _),
- assoc_list.values(Args, ArgTypes),
+ ArgTypes = list.map(func(C) = C ^ arg_type, Args),
typecheck_info_get_types(Info, Types),
map.lookup(Types, TypeCtor, TypeDefn),
hlds_data.get_type_defn_tvarset(TypeDefn, ConsTypeVarSet),
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.31
diff -u -r1.31 typecheck_errors.m
--- compiler/typecheck_errors.m 27 Sep 2006 06:17:08 -0000 1.31
+++ compiler/typecheck_errors.m 31 Oct 2006 04:52:47 -0000
@@ -1787,7 +1787,8 @@
make_list_term([]) = term.functor(term.atom("[]"), [], term.context_init).
make_list_term([Var | Vars]) = term.functor(term.atom("[|]"),
- [term.variable(Var), make_list_term(Vars)], term.context_init).
+ [term.variable(Var, context_init), make_list_term(Vars)],
+ term.context_init).
%-----------------------------------------------------------------------------%
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.177
diff -u -r1.177 unify_proc.m
--- compiler/unify_proc.m 15 Oct 2006 23:26:55 -0000 1.177
+++ compiler/unify_proc.m 31 Oct 2006 04:52:47 -0000
@@ -511,10 +511,11 @@
ExistQVars = [],
ClassConstraints = [],
- MakeUnamedField = (func(ArgType) = no - ArgType),
+ MakeUnamedField = (func(ArgType) = ctor_arg(no, ArgType, Context)),
CtorArgs = list.map(MakeUnamedField, TupleArgTypes),
- Ctor = ctor(ExistQVars, ClassConstraints, CtorSymName, CtorArgs),
+ Ctor = ctor(ExistQVars,
+ ClassConstraints, CtorSymName, CtorArgs, Context),
CtorSymName = unqualified("{}"),
ConsId = cons(CtorSymName, TupleArity),
@@ -1283,7 +1284,7 @@
generate_du_unify_clauses([], _X, _Y, _Context, [], !Info).
generate_du_unify_clauses([Ctor | Ctors], X, Y, Context, [Clause | Clauses],
!Info) :-
- Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes),
+ Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes, _Ctxt),
list.length(ArgTypes, FunctorArity),
FunctorConsId = cons(FunctorName, FunctorArity),
(
@@ -1360,7 +1361,7 @@
generate_du_index_clauses([], _X, _Index, _Context, _N, [], !Info).
generate_du_index_clauses([Ctor | Ctors], X, Index, Context, N,
[Clause | Clauses], !Info) :-
- Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes),
+ Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes, _Ctxt),
list.length(ArgTypes, FunctorArity),
FunctorConsId = cons(FunctorName, FunctorArity),
make_fresh_vars(ArgTypes, ExistQTVars, ArgVars, !Info),
@@ -1662,7 +1663,7 @@
hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det.
generate_compare_case(Ctor, R, X, Y, Context, Kind, Case, !Info) :-
- Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes),
+ Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes, _Ctxt),
list.length(ArgTypes, FunctorArity),
FunctorConsId = cons(FunctorName, FunctorArity),
(
@@ -1708,8 +1709,8 @@
generate_asymmetric_compare_case(Ctor1, Ctor2, CompareOp, R, X, Y, Context,
Case, !Info) :-
- Ctor1 = ctor(ExistQTVars1, _Constraints1, FunctorName1, ArgTypes1),
- Ctor2 = ctor(ExistQTVars2, _Constraints2, FunctorName2, ArgTypes2),
+ Ctor1 = ctor(ExistQTVars1, _Constraints1, FunctorName1, ArgTypes1, _Ctxt1),
+ Ctor2 = ctor(ExistQTVars2, _Constraints2, FunctorName2, ArgTypes2, _Ctxt2),
list.length(ArgTypes1, FunctorArity1),
list.length(ArgTypes2, FunctorArity2),
FunctorConsId1 = cons(FunctorName1, FunctorArity1),
@@ -1773,11 +1774,13 @@
compare_args_2([], _, [], [], R, Context, Return_Equal, !Info) :-
generate_return_equal(R, Context, Return_Equal).
-compare_args_2([_Name - Type | ArgTypes], ExistQTVars, [X | Xs], [Y | Ys], R,
+compare_args_2([Arg | ArgTypes], ExistQTVars, [X | Xs], [Y | Ys], R,
Context, Goal, !Info) :-
goal_info_init(GoalInfo0),
goal_info_set_context(Context, GoalInfo0, GoalInfo),
+ Type = Arg ^ arg_type,
+
% When comparing existentially typed arguments, the arguments may have
% different types; in that case, rather than just comparing them,
% which would be a type error, we call `typed_compare', which is a builtin
@@ -1906,7 +1909,7 @@
make_fresh_vars(CtorArgs, ExistQTVars, Vars, !Info) :-
(
ExistQTVars = [],
- assoc_list.values(CtorArgs, ArgTypes),
+ ArgTypes = list.map(func(C) = C ^ arg_type, CtorArgs),
make_fresh_vars_from_types(ArgTypes, Vars, !Info)
;
ExistQTVars = [_ | _],
@@ -1939,8 +1942,9 @@
unify_proc_info::in, unify_proc_info::out) is semidet.
unify_var_lists_2([], _, [], [], [], !Info).
-unify_var_lists_2([_Name - Type | ArgTypes], ExistQTVars, [X | Xs], [Y | Ys],
+unify_var_lists_2([Arg | ArgTypes], ExistQTVars, [X | Xs], [Y | Ys],
[Goal | Goals], !Info) :-
+ Type = Arg ^ arg_type,
term.context_init(Context),
(
info_get_module_info(!.Info, ModuleInfo),
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.22
diff -u -r1.22 untupling.m
--- compiler/untupling.m 1 Oct 2006 04:57:33 -0000 1.22
+++ compiler/untupling.m 31 Oct 2006 04:52:47 -0000
@@ -754,7 +754,7 @@
->
Arity = list.length(SingleCtorArgs),
ConsId = cons(SingleCtorName, Arity),
- ExpandedTypes = list.map(snd, SingleCtorArgs),
+ ExpandedTypes = list.map(func(C) = C ^ arg_type, SingleCtorArgs),
Expansion = expansion(ConsId, ExpandedTypes)
;
Expansion = no_expansion
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.4
diff -u -r1.4 unused_imports.m
--- compiler/unused_imports.m 13 Oct 2006 04:52:27 -0000 1.4
+++ compiler/unused_imports.m 31 Oct 2006 04:52:47 -0000
@@ -218,12 +218,13 @@
:- pred ctor_used_modules(item_visibility::in, constructor::in,
used_modules::in, used_modules::out) is det.
-ctor_used_modules(Visibility, ctor(_, Constraints, _, Args), !UsedModules) :-
+ctor_used_modules(Visibility,
+ ctor(_, Constraints, _, Args, _), !UsedModules) :-
list.foldl(prog_constraint_used_module(Visibility), Constraints,
!UsedModules),
list.foldl(
- (pred(_ - Arg::in, !.M::in, !:M::out) is det :-
- mer_type_used_modules(Visibility, Arg, !M)
+ (pred(Arg::in, !.M::in, !:M::out) is det :-
+ mer_type_used_modules(Visibility, Arg ^ arg_type, !M)
), Args, !UsedModules).
:- pred prog_constraint_used_module(item_visibility::in, prog_constraint::in,
Index: library/parser.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/parser.m,v
retrieving revision 1.55
diff -u -r1.55 parser.m
--- library/parser.m 24 Oct 2006 02:59:46 -0000 1.55
+++ library/parser.m 31 Oct 2006 04:52:47 -0000
@@ -491,17 +491,17 @@
parse_backquoted_operator(Qualifier, OpName, VariableTerm, !PS) :-
parser_get_token_context(Token, Context, !PS),
+ get_term_context(!.PS, Context, TermContext),
(
Token = variable(VariableOp),
Qualifier = no,
OpName = "",
add_var(VariableOp, Var, !PS),
- VariableTerm = [variable(Var)]
+ VariableTerm = [variable(Var, TermContext)]
;
Token = name(OpName0),
VariableTerm = [],
- get_term_context(!.PS, Context, OpCtxt0),
- parse_backquoted_operator_2(no, Qualifier, OpCtxt0, OpName0, OpName,
+ parse_backquoted_operator_2(no, Qualifier, TermContext, OpName0, OpName,
!PS)
).
@@ -597,9 +597,10 @@
Term = ok(term.functor(term.atom(Atom), [], TermContext))
).
-parse_simple_term_2(variable(VarName), _, _, Term, !PS) :-
+parse_simple_term_2(variable(VarName), Context, _, Term, !PS) :-
add_var(VarName, Var, !PS),
- Term = ok(term.variable(Var)).
+ get_term_context(!.PS, Context, TermContext),
+ Term = ok(term.variable(Var, TermContext)).
parse_simple_term_2(integer(Int), Context, _, Term, !PS) :-
get_term_context(!.PS, Context, TermContext),
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.124
diff -u -r1.124 term.m
--- library/term.m 23 Oct 2006 00:33:01 -0000 1.124
+++ library/term.m 31 Oct 2006 04:52:47 -0000
@@ -36,7 +36,8 @@
term.context
)
; variable(
- var(T)
+ var(T),
+ term.context
).
:- type const
@@ -399,15 +400,16 @@
% Abort (call error/1) if the list contains any non-variables.
%
:- func term_list_to_var_list(list(term(T))) = list(var(T)).
-:- pred term_list_to_var_list(list(term(T))::in, list(var(T))::out) is det.
+
+ % Convert a list of terms which are all vars into a list of vars.
+ %
+:- pred term_list_to_var_list(list(term(T))::in, list(var(T))::out) is semidet.
% Convert a list of terms which are all vars into a list of vars
% (or vice versa).
%
:- func var_list_to_term_list(list(var(T))) = list(term(T)).
-:- pred var_list_to_term_list(list(var(T)), list(term(T))).
-:- mode var_list_to_term_list(in, out) is det.
-:- mode var_list_to_term_list(out, in) is semidet.
+:- pred var_list_to_term_list(list(var(T))::in, list(term(T))::out) is det.
%-----------------------------------------------------------------------------%
@@ -497,7 +499,7 @@
type_desc::in, term_to_type_context::in,
term_to_type_result(univ, T)::out) is det.
-try_term_to_univ_2(variable(Var), _Type, Context,
+try_term_to_univ_2(variable(Var, _), _Type, Context,
error(mode_error(Var, Context))).
try_term_to_univ_2(Term, Type, Context, Result) :-
Term = functor(Functor, ArgTerms, TermContext),
@@ -782,7 +784,7 @@
vars_list(Terms, Vars) :-
vars_2_list(Terms, [], Vars).
-vars_2(variable(Var), !Vars) :-
+vars_2(variable(Var, _), !Vars) :-
!:Vars = [Var | !.Vars].
vars_2(functor(_, Args, _), !Vars) :-
vars_2_list(Args, !Vars).
@@ -797,7 +799,7 @@
%-----------------------------------------------------------------------------%
-contains_var(variable(Var), Var).
+contains_var(variable(Var, _), Var).
contains_var(functor(_, Args, _), Var) :-
contains_var_list(Args, Var).
@@ -815,7 +817,7 @@
%-----------------------------------------------------------------------------%
-unify_term(variable(X), variable(Y), !Bindings) :-
+unify_term(variable(X, _), VarY @ variable(Y, _), !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
( map.search(!.Bindings, Y, BindingOfY) ->
% Both X and Y already have bindings - just unify the terms
@@ -824,7 +826,7 @@
;
% Y is a variable which hasn't been bound yet.
apply_rec_substitution(BindingOfX, !.Bindings, SubstBindingOfX),
- ( SubstBindingOfX = variable(Y) ->
+ ( SubstBindingOfX = variable(Y, _) ->
true
;
\+ occurs(SubstBindingOfX, Y, !.Bindings),
@@ -835,7 +837,7 @@
( map.search(!.Bindings, Y, BindingOfY) ->
% X is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfY, !.Bindings, SubstBindingOfY),
- ( SubstBindingOfY = variable(X) ->
+ ( SubstBindingOfY = variable(X, _) ->
true
;
\+ occurs(SubstBindingOfY, X, !.Bindings),
@@ -847,12 +849,12 @@
( X = Y ->
true
;
- map.set(!.Bindings, X, variable(Y), !:Bindings)
+ map.set(!.Bindings, X, VarY, !:Bindings)
)
)
).
-unify_term(term.variable(X), term.functor(F, As, C), !Bindings) :-
+unify_term(term.variable(X, _), term.functor(F, As, C), !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
unify_term(BindingOfX, functor(F, As, C), !Bindings)
;
@@ -860,7 +862,7 @@
map.set(!.Bindings, X, functor(F, As, C), !:Bindings)
).
-unify_term(functor(F, As, C), variable(X), !Bindings) :-
+unify_term(functor(F, As, C), variable(X, _), !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
unify_term(functor(F, As, C), BindingOfX, !Bindings)
;
@@ -876,7 +878,8 @@
unify_term(X, Y, !Bindings),
unify_term_list(Xs, Ys, !Bindings).
-unify_term_dont_bind(variable(X), variable(Y), BoundVars, !Bindings) :-
+unify_term_dont_bind(variable(X, _), VarY @ variable(Y, _),
+ BoundVars, !Bindings) :-
( list.member(Y, BoundVars) ->
unify_term_bound_var(X, Y, BoundVars, !Bindings)
; list.member(X, BoundVars) ->
@@ -889,7 +892,7 @@
;
apply_rec_substitution(BindingOfX, !.Bindings, SubstBindingOfX),
% Y is a variable which hasn't been bound yet.
- ( SubstBindingOfX = variable(Y) ->
+ ( SubstBindingOfX = variable(Y, _) ->
true
;
\+ occurs(SubstBindingOfX, Y, !.Bindings),
@@ -900,7 +903,7 @@
( map.search(!.Bindings, Y, BindingOfY) ->
apply_rec_substitution(BindingOfY, !.Bindings, SubstBindingOfY),
% X is a variable which hasn't been bound yet.
- ( SubstBindingOfY = variable(X) ->
+ ( SubstBindingOfY = variable(X, _) ->
true
;
\+ occurs(SubstBindingOfY, X, !.Bindings),
@@ -911,12 +914,12 @@
( X = Y ->
true
;
- svmap.det_insert(X, variable(Y), !Bindings)
+ svmap.det_insert(X, VarY, !Bindings)
)
)
).
-unify_term_dont_bind(variable(X), functor(F, As, C), BoundVars, !Bindings) :-
+unify_term_dont_bind(variable(X, _), functor(F, As, C), BoundVars, !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
unify_term_dont_bind(BindingOfX, functor(F, As, C), BoundVars,
!Bindings)
@@ -926,7 +929,7 @@
svmap.det_insert(X, functor(F, As, C), !Bindings)
).
-unify_term_dont_bind(functor(F, As, C), variable(X), BoundVars, !Bindings) :-
+unify_term_dont_bind(functor(F, As, C), variable(X, _), BoundVars, !Bindings) :-
( map.search(!.Bindings, X, BindingOfX) ->
unify_term_dont_bind(functor(F, As, C), BindingOfX, BoundVars,
!Bindings)
@@ -959,14 +962,14 @@
unify_term_bound_var(Var, BoundVar, BoundVars, !Bindings) :-
( map.search(!.Bindings, Var, BindingOfVar) ->
- BindingOfVar = variable(Var2),
+ BindingOfVar = variable(Var2, _),
unify_term_bound_var(Var2, BoundVar, BoundVars, !Bindings)
;
( Var = BoundVar ->
true
;
\+ list.member(Var, BoundVars),
- svmap.det_insert(Var, variable(BoundVar), !Bindings)
+ svmap.det_insert(Var, variable(BoundVar, context_init), !Bindings)
)
).
@@ -979,7 +982,7 @@
%-----------------------------------------------------------------------------%
-occurs(variable(X), Y, Bindings) :-
+occurs(variable(X, _), Y, Bindings) :-
( X = Y ->
true
;
@@ -998,11 +1001,11 @@
%-----------------------------------------------------------------------------%
-substitute(variable(Var), SearchVar, Replacement, Term) :-
+substitute(V @ variable(Var, _), SearchVar, Replacement, Term) :-
( Var = SearchVar ->
Term = Replacement
;
- Term = variable(Var)
+ Term = V
).
substitute(functor(Name, Args0, Context), Var, Replacement,
functor(Name, Args, Context)) :-
@@ -1039,12 +1042,12 @@
%-----------------------------------------------------------------------------%
-apply_rec_substitution(variable(Var), Substitution, Term) :-
+apply_rec_substitution(V @ variable(Var, _), Substitution, Term) :-
( map.search(Substitution, Var, Replacement) ->
% Recursively apply the substition to the replacement.
apply_rec_substitution(Replacement, Substitution, Term)
;
- Term = variable(Var)
+ Term = V
).
apply_rec_substitution(functor(Name, Args0, Context), Substitution,
functor(Name, Args, Context)) :-
@@ -1058,11 +1061,11 @@
%-----------------------------------------------------------------------------%
-apply_substitution(variable(Var), Substitution, Term) :-
+apply_substitution(V @ variable(Var, _), Substitution, Term) :-
( map.search(Substitution, Var, Replacement) ->
Term = Replacement
;
- Term = variable(Var)
+ Term = V
).
apply_substitution(functor(Name, Args0, Context), Substitution,
functor(Name, Args, Context)) :-
@@ -1108,7 +1111,8 @@
relabel_variable(functor(Const, Terms0, Cont), OldVar, NewVar,
functor(Const, Terms, Cont)) :-
relabel_variables(Terms0, OldVar, NewVar, Terms).
-relabel_variable(variable(Var0), OldVar, NewVar, variable(Var)) :-
+relabel_variable(variable(Var0, Context),
+ OldVar, NewVar, variable(Var, Context)) :-
( Var0 = OldVar ->
Var = NewVar
;
@@ -1123,8 +1127,8 @@
apply_variable_renaming(functor(Const, Args0, Cont), Renaming,
functor(Const, Args, Cont)) :-
apply_variable_renaming_to_list(Args0, Renaming, Args).
-apply_variable_renaming(variable(Var0), Renaming,
- variable(Var)) :-
+apply_variable_renaming(variable(Var0, Context), Renaming,
+ variable(Var, Context)) :-
apply_variable_renaming_to_var(Renaming, Var0, Var).
apply_variable_renaming_to_list([], _, []).
@@ -1146,20 +1150,17 @@
%-----------------------------------------------------------------------------%
-term_list_to_var_list(Terms, Vars) :-
- ( var_list_to_term_list(Vars0, Terms) ->
- Vars = Vars0
- ;
- error("term.term_list_to_var_list")
- ).
+term_list_to_var_list([], []).
+term_list_to_var_list([variable(Var, _) | Terms], [Var | Vars]) :-
+ term_list_to_var_list(Terms, Vars).
var_list_to_term_list([], []).
-var_list_to_term_list([Var | Vars], [variable(Var) | Terms]) :-
+var_list_to_term_list([Var | Vars], [variable(Var, context_init) | Terms]) :-
var_list_to_term_list(Vars, Terms).
%-----------------------------------------------------------------------------%
-is_ground_in_bindings(variable(V), Bindings) :-
+is_ground_in_bindings(variable(V, _), Bindings) :-
map.search(Bindings, V, Binding),
is_ground_in_bindings(Binding, Bindings).
is_ground_in_bindings(functor(_, Args, _), Bindings) :-
@@ -1288,7 +1289,11 @@
context_init(S, N, C).
term_list_to_var_list(Ts) = Vs :-
- term_list_to_var_list(Ts, Vs).
+ ( term_list_to_var_list(Ts, Vs0) ->
+ Vs = Vs0
+ ;
+ error("term.term_list_to_var_list: not all vars")
+ ).
var_list_to_term_list(Vs) = Ts :-
var_list_to_term_list(Vs, Ts).
Index: library/term_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_io.m,v
retrieving revision 1.82
diff -u -r1.82 term_io.m
--- library/term_io.m 27 Sep 2006 06:16:44 -0000 1.82
+++ library/term_io.m 31 Oct 2006 04:52:47 -0000
@@ -291,7 +291,7 @@
varset(T)::in, varset(T)::out, int::in, int::out,
io::di, io::uo) is det <= op_table(Ops).
-term_io.write_term_3(Ops, term.variable(Id), _, !VarSet, !N, !IO) :-
+term_io.write_term_3(Ops, term.variable(Id, _), _, !VarSet, !N, !IO) :-
term_io.write_variable_2(Ops, Id, !VarSet, !N, !IO).
term_io.write_term_3(Ops, term.functor(Functor, Args, _), Priority,
!VarSet, !N, !IO) :-
@@ -328,7 +328,7 @@
% gets parsed as ''(Var, Arg). When writing it out, we want to use
% the nice syntax.
Functor = term.atom(""),
- Args = [term.variable(Var), FirstArg | OtherArgs]
+ Args = [term.variable(Var, context_init), FirstArg | OtherArgs]
->
term_io.write_variable_2(Ops, Var, !VarSet, !N, !IO),
io.write_char('(', !IO),
@@ -432,7 +432,7 @@
term_io.write_list_tail(Ops, Term, !VarSet, !N, !IO) :-
(
- Term = term.variable(Id),
+ Term = term.variable(Id, _),
varset.search_var(!.VarSet, Id, Val)
->
term_io.write_list_tail(Ops, Val, !VarSet, !N, !IO)
Index: library/varset.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/varset.m,v
retrieving revision 1.79
diff -u -r1.79 varset.m
--- library/varset.m 19 Apr 2006 05:17:59 -0000 1.79
+++ library/varset.m 31 Oct 2006 04:52:47 -0000
@@ -498,7 +498,7 @@
;
true
),
- map.set(!.Subst, VarN, term.variable(VarId), !:Subst),
+ map.set(!.Subst, VarN, term.variable(VarId, context_init), !:Subst),
varset.merge_subst_2(IncludeNames, N1, Max, Names, Values,
!VarSet, !Subst)
).
New File: compiler/xml_documentation.m
===================================================================
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% Module: xml_documentation.m
% Main authors: petdr.
%
% This module outputs an XML representation of a module,
% which can then be transformed by a stylesheet into some other
% documentation format.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.xml_documentation.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module io.
%
% Output a representation of the module in XML which can be used
% to document the module.
%
:- pred xml_documentation(module_info::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.source_file_map.
:- import_module bool.
:- import_module char.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module string.
:- import_module svmap.
:- import_module term.
:- import_module term_to_xml.
:- import_module varset.
%
% Record all the locations of comments in a file.
%
:- type comments
---> comments(
% For each line record what is on the line.
line_types :: map(int, line_type)
).
:- type line_type
% A line containing only whitespace.
---> blank
% A line containing just a comment.
; comment(string)
% A line which contains both a comment and code.
; code_and_comment(string)
% A line containing code.
; code
.
%-----------------------------------------------------------------------------%
xml_documentation(ModuleInfo, !IO) :-
module_info_get_name(ModuleInfo, ModuleName),
module_name_to_file_name(ModuleName, ".xml", no, FileName, !IO),
lookup_module_source_file(ModuleName, SrcFileName, !IO),
io.open_input(SrcFileName, SrcResult, !IO),
( SrcResult = ok(SrcStream),
build_comments(SrcStream, comments(map.init), Comments, !IO),
io.open_output(FileName, OpenResult, !IO),
( OpenResult = ok(Stream),
ModuleInfoXmlDoc = module_info_xml_doc(Comments, ModuleInfo),
write_xml_doc_to_stream(Stream, ModuleInfoXmlDoc, !IO)
; OpenResult = error(Err),
unable_to_open_file(FileName, Err, !IO)
)
; SrcResult = error(SrcErr),
unable_to_open_file(SrcFileName, SrcErr, !IO)
).
:- pred unable_to_open_file(string::in, io.error::in, io::di, io::uo) is det.
unable_to_open_file(FileName, IOErr, !IO) :-
io.stderr_stream(StdErr, !IO),
io.write_string(StdErr, "Unable to open file: '", !IO),
io.write_string(StdErr, FileName, !IO),
io.write_string(StdErr, "' because\n", !IO),
io.write_string(StdErr, io.error_message(IOErr), !IO),
io.nl(StdErr, !IO),
io.set_exit_status(1).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Given the input_stream build the comments datastructure which
% represents this stream.
%
:- pred build_comments(io.input_stream::in, comments::in, comments::out,
io::di, io::uo) is det.
build_comments(S, comments(!.C), comments(!:C), !IO) :-
io.get_line_number(S, LineNumber, !IO),
io.read_line(S, LineResult, !IO),
( LineResult = ok(Line),
svmap.set(LineNumber, line_type(Line), !C),
build_comments(S, comments(!.C), comments(!:C), !IO)
; LineResult = eof,
true
; LineResult = error(_),
true
).
%
% Given a list of character representing one line
% return the type of the line.
%
% Note this predicate is pretty stupid at the moment.
% It only recognizes lines which contains % comments.
% It also is confused by % characters in strings, etc. etc.
%
:- func line_type(list(character)) = line_type.
line_type(Line) = LineType :-
list.takewhile(char.is_whitespace, Line, _WhiteSpace, Rest),
list.takewhile(is_not_comment_char, Rest, Decl, Comment),
( Rest = [] ->
LineType = blank
; Comment = [_|_] ->
( Decl = [] ->
LineType = comment(string.from_char_list(Comment))
;
LineType = code_and_comment(string.from_char_list(Comment))
)
;
LineType = code
).
:- pred is_not_comment_char(char::in) is semidet.
is_not_comment_char(C) :-
C \= '%'.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
% Comment selection strategies
%
% Get the XML representation of the comment associated
% with the given prog_context.
%
:- func comment(comments, prog_context) = xml.
comment(Comments, Context) =
elem("comment", [], [cdata(get_comment(Comments, Context))]).
%
% Get the comment string associated with the given prog_context.
%
:- func get_comment(comments, prog_context) = string.
get_comment(Comments, context(_, Line)) =
%
% XXX at a later date this hard-coded strategy should
% be made more flexible. What I imagine is that the
% user would pass a string saying in what order
% they wish to search for comments.
%
( comment_on_current_line(Comments, Line, C) ->
C
; comment_directly_above(Comments, Line, C) ->
C
;
""
).
%-----------------------------------------------------------------------------%
%
% Succeeds if the current line has a comment.
% The comment is extended with all the lines following
% the current line which just contain a comment.
%
:- pred comment_on_current_line(comments::in, int::in, string::out) is semidet.
comment_on_current_line(Comments, Line, Comment) :-
map.search(Comments ^ line_types, Line, code_and_comment(Comment0)),
RestComment = get_comment_forwards(Comments, Line + 1),
Comment = Comment0 ++ RestComment.
%
% Succeeds if the comment is directly above the current line.
% The comment above ends when we find a line above the current
% line which doesn't just contain a comment.
%
:- pred comment_directly_above(comments::in, int::in, string::out) is semidet.
comment_directly_above(Comments, Line, Comment) :-
map.search(Comments ^ line_types, Line - 1, comment(_)),
Comment = get_comment_backwards(Comments, Line - 1).
%
% Return the string which represents the comment starting at the given
% line. The comment ends when a line which is not a plain comment line
% is found.
%
:- func get_comment_forwards(comments, int) = string.
get_comment_forwards(Comments, Line) = Comment :-
LineType = map.lookup(Comments ^ line_types, Line),
( LineType = comment(CurrentComment),
CommentBelow = get_comment_backwards(Comments, Line + 1),
Comment = CurrentComment ++ CommentBelow
; ( LineType = blank ; LineType = code ; LineType = code_and_comment(_) ),
Comment = ""
).
%
% Return the string which represents the comment ending at the given line.
% The comment extends backwards until the the line above the given
% line is not a comment only line.
%
:- func get_comment_backwards(comments, int) = string.
get_comment_backwards(Comments, Line) = Comment :-
LineType = map.lookup(Comments ^ line_types, Line),
( LineType = comment(CurrentComment),
CommentAbove = get_comment_backwards(Comments, Line - 1),
Comment = CommentAbove ++ CurrentComment
; ( LineType = blank ; LineType = code ; LineType = code_and_comment(_) ),
Comment = ""
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- type module_info_xml_doc
---> module_info_xml_doc(comments, module_info).
:- instance xmlable(module_info_xml_doc) where [
(to_xml(module_info_xml_doc(Comments, ModuleInfo)) = Xml :-
module_info_get_type_table(ModuleInfo, TypeTable),
map.foldl(type_documentation(Comments), TypeTable, [], TypeXmls),
TypeXml = elem("types", [], TypeXmls),
Xml = elem("module", [], [TypeXml])
)
].
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Output the documentation of one type.
%
:- pred type_documentation(comments::in, type_ctor::in, hlds_type_defn::in,
list(xml)::in, list(xml)::out) is det.
type_documentation(C, type_ctor(TypeName, TypeArity), TypeDefn, !Xmls) :-
get_type_defn_status(TypeDefn, ImportStatus),
( status_defined_in_this_module(ImportStatus) = yes ->
get_type_defn_body(TypeDefn, TypeBody),
get_type_defn_tvarset(TypeDefn, TVarset),
get_type_defn_context(TypeDefn, Context),
XmlComment = comment(C, Context),
Tag = type_xml_tag(TypeBody),
Id = attr("id", sym_name_and_arity_to_id("type", TypeName, TypeArity)),
Children = [XmlComment, prog_context(Context) |
type_body(C, TVarset, TypeBody)],
Xml = elem(Tag, [Id], Children),
!:Xmls = [Xml | !.Xmls]
;
true
).
:- func type_xml_tag(hlds_type_body) = string.
type_xml_tag(hlds_du_type(_, _, _, _, _, _)) = "du_type".
type_xml_tag(hlds_eqv_type(_)) = "eqv_type".
type_xml_tag(hlds_foreign_type(_)) = "foreign_type".
type_xml_tag(hlds_solver_type(_, _)) = "solver_type".
type_xml_tag(hlds_abstract_type(_)) = "abstract_type".
:- func type_body(comments, tvarset, hlds_type_body) = list(xml).
type_body(C, TVarset, hlds_du_type(Ctors, _, _, _, _, _)) = Xml :-
Xml = [xml_list("constructors", constructor(C, TVarset), Ctors)].
% XXX TODO
type_body(_, _, hlds_eqv_type(_)) = [nyi("hlds_eqv_type")].
type_body(_, _, hlds_foreign_type(_)) = [nyi("hlds_foreign_type")].
type_body(_, _, hlds_solver_type(_, _)) = [nyi("hlds_solver_type")].
type_body(_, _, hlds_abstract_type(_)) = [nyi("hlds_abstract_type")].
:- func constructor(comments, tvarset, constructor) = xml.
constructor(C, TVarset,
ctor(_Exist, _Constraints, Name, Args, Context)) = Xml :-
Id = attr("id", sym_name_and_arity_to_id("cons", Name, length(Args))),
XmlName = name(Name),
XmlComment = comment(C, Context),
XmlContext = prog_context(Context),
XmlArgs = [xml_list("args", constructor_arg(C, TVarset), Args)],
Xml = elem("constructor", [Id],
[XmlName, XmlComment, XmlContext | XmlArgs]).
:- func constructor_arg(comments, tvarset, constructor_arg) = xml.
constructor_arg(C, TVarset, ctor_arg(MaybeFieldName, Type, Context)) = Xml :-
XmlType = elem("type", [], [mer_type(TVarset, Type)]),
Comment = comment(C, Context),
XmlContext = prog_context(Context),
( MaybeFieldName = yes(FieldName),
Id = attr("Id", sym_name_to_id("field", FieldName)),
XmlMaybeFieldName = [elem("field", [Id], [name(FieldName)])]
; MaybeFieldName = no,
XmlMaybeFieldName = []
),
Xml = elem("arg", [], [XmlType, Comment, XmlContext | XmlMaybeFieldName]).
:- func mer_type(tvarset, mer_type) = xml.
mer_type(TVarset, type_variable(TVar, _)) = Xml :-
TVarName = varset.lookup_name(TVarset, TVar),
Xml = tagged_string("type_variable", TVarName).
mer_type(TVarset, defined_type(TypeName, Args, _)) = Xml :-
Ref = attr("ref", sym_name_and_arity_to_id("type", TypeName, length(Args))),
XmlName = name(TypeName),
XmlArgs = xml_list("args", mer_type(TVarset), Args),
Xml = elem("type", [Ref], [XmlName, XmlArgs]).
mer_type(_, builtin_type(builtin_type_int)) = elem("int", [], []).
mer_type(_, builtin_type(builtin_type_float)) = elem("float", [], []).
mer_type(_, builtin_type(builtin_type_string)) = elem("string", [], []).
mer_type(_, builtin_type(builtin_type_character)) = elem("character", [], []).
mer_type(_, higher_order_type(_, _, _, _)) = nyi("higher_order_type").
mer_type(_, tuple_type(_, _)) = nyi("tuple_type").
mer_type(_, apply_n_type(_, _, _)) = nyi("apply_n_type").
mer_type(_, kinded_type(_, _)) = nyi("kinded_type").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- func name(sym_name) = xml.
name(unqualified(Name)) = tagged_string("unqualified", Name).
name(qualified(Module, Name)) =
elem("qualified", [], [
tagged_string("module", sym_name_to_string(Module)),
tagged_string("name", Name)]).
%-----------------------------------------------------------------------------%
:- func prog_context(prog_context) = xml.
prog_context(context(FileName, LineNumber)) =
elem("context", [], [
tagged_string("filename", FileName),
tagged_int("line", LineNumber)]).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% sym_name_to_id(P, S) converts the sym_name, S, into
% a string with prefix, P, prefixed to the generated name.
%
:- func sym_name_to_id(string, sym_name) = string.
sym_name_to_id(Prefix, Name) = prefixed_sym_name(Prefix, Name).
%
% sym_name_to_id(P, S, A) converts the sym_name, S, with
% arity, A, into a string with prefix, P, prefixed to the
% generated name.
%
:- func sym_name_and_arity_to_id(string, sym_name, int) = string.
sym_name_and_arity_to_id(Prefix, Name, Arity) =
prefixed_sym_name(Prefix, Name) ++ "/" ++ int_to_string(Arity).
:- func prefixed_sym_name(string, sym_name) = string.
prefixed_sym_name(Prefix, Name) = Prefix ++ "." ++ sym_name_to_string(Name).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- func tagged_string(string, string) = xml.
tagged_string(E, S) = elem(E, [], [data(S)]).
:- func tagged_int(string, int) = xml.
tagged_int(E, I) = elem(E, [], [data(int_to_string(I))]).
%-----------------------------------------------------------------------------%
:- func xml_list(string, func(T) = xml, list(T)) = xml.
xml_list(Tag, F, L) = elem(Tag, [], list.map(F, L)).
%-----------------------------------------------------------------------------%
:- func nyi(string) = xml.
nyi(Tag) = tagged_string(Tag, "Not yet implemented!").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list